;;; Wall2Line.lsp - Version 8.0 / Phase-2 wall linework and settings panel
;;; Converts selected single-line wall paths to cleaned four-line layered walls.
;;; Commands: WALL2LINE or W2L
;;;
;;; Justification rules:
;;;   Center - offsets half the thickness to both sides, then removes centerline.
;;;   Left   - keeps the source line and offsets full thickness to its left.
;;;   Right  - keeps the source line and offsets full thickness to its right.
;;;
;;; Left and right are relative to the drawing direction of each object.
;;;
;;; Four longitudinal lines represent:
;;;   finished face / core face / core face / finished face.
;;; Interior/exterior finish values are assigned by the Exterior Side choice.
;;; Free wall ends are capped automatically.
;;;
;;; Straight POLYLINE paths are normalized to LINE/ARC segments first so their
;;; terminal segments participate in the same cleanup as standalone LINEs.
;;; Automatic cleanup for straight LINE segments:
;;;   - Open and overlapping corners are mitered (FILLET radius 0 logic).
;;;   - T-junction branches are trimmed to the near face of the host wall.
;;;   - Split hosts and four-way nodes are resolved as one through axis.
;;;   - Only the near finish/core host faces are opened at a T-junction.
;;;   - Collinear source pieces are rejoined before junction trimming.
;;;   - Interior/interior crossings are opened with layer-matched widths.

(vl-load-com)

;;; ---------------------------------------------------------------------------
;;; Settings panel and persistent session defaults
;;; ---------------------------------------------------------------------------

(defun W2L:SetDefault (symbol value)
  (if (not (boundp symbol)) (set symbol value)))

(W2L:SetDefault '*W2L-Thickness* 200.0)
(W2L:SetDefault '*W2L-InteriorFinish* 20.0)
(W2L:SetDefault '*W2L-ExteriorFinish* 20.0)
(W2L:SetDefault '*W2L-Justification* "Center")
(W2L:SetDefault '*W2L-ExteriorSide* "Left")
(W2L:SetDefault '*W2L-CoreLayer* "A-WALL-CORE")
(W2L:SetDefault '*W2L-InteriorLayer* "A-WALL-FIN-IN")
(W2L:SetDefault '*W2L-ExteriorLayer* "A-WALL-FIN-EX")
(W2L:SetDefault '*W2L-HatchLayer* "A-WALL-HATCH")
(W2L:SetDefault '*W2L-AutoCreateLayers* T)
(W2L:SetDefault '*W2L-CreateHatch* nil)
(W2L:SetDefault '*W2L-HatchPattern* "ANSI31")
(W2L:SetDefault '*W2L-HatchScale* 1.0)
(W2L:SetDefault '*W2L-HatchAngle* 0.0)
(W2L:SetDefault '*W2L-NormalizePolylines* T)
(W2L:SetDefault '*W2L-JoinContinuations* T)
(W2L:SetDefault '*W2L-CleanCorners* T)
(W2L:SetDefault '*W2L-CleanTJunctions* T)
(W2L:SetDefault '*W2L-CleanCrossings* T)
(W2L:SetDefault '*W2L-CloseEnds* T)
(W2L:SetDefault '*W2L-KeepCenterlines* nil)

(setq *W2L-HatchPatterns*
       '("SOLID" "ANSI31" "ANSI32" "ANSI33" "AR-CONC"
         "AR-B816" "BRICK" "EARTH" "GRAVEL" "NET" "DOTS"))

(defun W2L:ListIndex (value values / index result item)
  (setq index 0 result 0)
  (foreach item values
    (if (= (strcase item) (strcase value))
      (setq result index))
    (setq index (1+ index)))
  result)

(defun W2L:BoolTile (value)
  (if value "1" "0"))

(defun W2L:ValidLayerNameP (name)
  (and name (> (strlen name) 0) (snvalid name)))

(defun W2L:StringMemberCI (value values / found item)
  (foreach item values
    (if (= (strcase item) (strcase value)) (setq found T)))
  found)

(defun W2L:AddUniqueString (value values)
  (if (or (null value) (W2L:StringMemberCI value values))
    values
    (cons value values)))

(defun W2L:GetLayerNames (/ item names flags)
  (setq item (tblnext "LAYER" T)
        names nil)
  (while item
    (setq flags (cdr (assoc 70 item)))
    ;; Xref-dependent layers cannot safely receive new output entities.
    (if (= (logand 16 (if flags flags 0)) 0)
      (setq names (W2L:AddUniqueString (cdr (assoc 2 item)) names)))
    (setq item (tblnext "LAYER")))
  (vl-sort names
    '(lambda (left right) (< (strcase left) (strcase right)))))

(defun W2L:BuildLayerChoices (/ names name)
  ;; Keep the configured defaults available even when they do not exist yet;
  ;; the Auto-create toggle can create them after the dialog is accepted.
  (setq names (W2L:GetLayerNames))
  (foreach name
    (list *W2L-CoreLayer* *W2L-InteriorLayer*
          *W2L-ExteriorLayer* *W2L-HatchLayer*)
    (setq names (W2L:AddUniqueString name names)))
  (vl-sort names
    '(lambda (left right) (< (strcase left) (strcase right)))))

(defun W2L:FillPopup (key values selected / item)
  (start_list key)
  (foreach item values (add_list item))
  (end_list)
  (set_tile key (itoa (W2L:ListIndex selected values))))

(defun W2L:PopupValue (key values / index)
  (setq index (atoi (get_tile key)))
  (if (and (>= index 0) (< index (length values)))
    (nth index values)))

(defun W2L:WriteDialogFile (/ path stream lines line)
  (setq path (vl-filename-mktemp "Wall2Line" nil ".dcl")
        stream (open path "w")
        lines
          '("wall2line_panel : dialog {"
            "  label = \"Wall2Line - Phase 2 Wall Builder\";"
            "  : row {"
            "    : boxed_column { label = \"Geometry\"; width = 34;"
            "      : edit_box { key = \"core_thk\"; label = \"Core thickness:\"; edit_width = 12; }"
            "      : edit_box { key = \"finish_in\"; label = \"Interior finish:\"; edit_width = 12; }"
            "      : edit_box { key = \"finish_ex\"; label = \"Exterior finish:\"; edit_width = 12; }"
            "      : boxed_radio_row { label = \"Justification\";"
            "        : radio_button { key = \"just_center\"; label = \"Center\"; }"
            "        : radio_button { key = \"just_left\"; label = \"Left\"; }"
            "        : radio_button { key = \"just_right\"; label = \"Right\"; }"
            "      }"
            "      : boxed_radio_row { label = \"Exterior side\";"
            "        : radio_button { key = \"ext_left\"; label = \"Left\"; }"
            "        : radio_button { key = \"ext_right\"; label = \"Right\"; }"
            "      }"
            "      : toggle { key = \"keep_center\"; label = \"Keep source centerlines (Center mode)\"; }"
            "    }"
            "    : boxed_column { label = \"Output layers\"; width = 36;"
            "      : popup_list { key = \"layer_core\"; label = \"Core line layer:\"; edit_width = 18; }"
            "      : popup_list { key = \"layer_in\"; label = \"Interior finish layer:\"; edit_width = 18; }"
            "      : popup_list { key = \"layer_ex\"; label = \"Exterior finish layer:\"; edit_width = 18; }"
            "      : popup_list { key = \"layer_hatch\"; label = \"Core hatch layer:\"; edit_width = 18; }"
            "      : toggle { key = \"create_layers\"; label = \"Create missing layers automatically\"; }"
            "    }"
            "  }"
            "  : row {"
            "    : boxed_column { label = \"Cleanup\"; width = 34;"
            "      : toggle { key = \"normalize\"; label = \"Normalize polylines to segments\"; }"
            "      : toggle { key = \"join_split\"; label = \"Join collinear split lines\"; }"
            "      : toggle { key = \"clean_corner\"; label = \"Clean open/overlapping corners\"; }"
            "      : toggle { key = \"clean_t\"; label = \"Clean T-junctions\"; }"
            "      : toggle { key = \"clean_cross\"; label = \"Clean interior crossings\"; }"
            "      : toggle { key = \"close_ends\"; label = \"Close true free ends\"; }"
            "    }"
            "    : boxed_column { label = \"Core hatch\"; width = 36;"
            "      : toggle { key = \"make_hatch\"; label = \"Create core hatch\"; }"
            "      : row {"
            "        : column {"
            "          : popup_list { key = \"hatch_pattern\"; label = \"Pattern:\"; edit_width = 14; }"
            "          : edit_box { key = \"hatch_scale\"; label = \"Scale:\"; edit_width = 10; }"
            "          : edit_box { key = \"hatch_angle\"; label = \"Angle (degrees):\"; edit_width = 10; }"
            "        }"
            "        : boxed_column { label = \"Pattern preview\";"
            "          : image { key = \"hatch_preview\"; width = 22; height = 7; fixed_width = true; fixed_height = true; color = 0; }"
            "        }"
            "      }"
            "      : text { label = \"Hatch is generated for straight core segments.\"; }"
            "    }"
            "  }"
            "  : text { label = \"Press Build, then select the single-line wall paths.\"; alignment = centered; }"
            "  : row {"
            "    : button { key = \"accept\"; label = \"Build walls\"; is_default = true; fixed_width = true; width = 16; }"
            "    : button { key = \"cancel\"; label = \"Cancel\"; is_cancel = true; fixed_width = true; width = 12; }"
            "  }"
            "}"))
  (if stream
    (progn
      (foreach line lines (write-line line stream))
      (close stream)
      path)))

(defun W2L:PreviewLine (width height x1 y1 x2 y2 color)
  (vector_image
    (max 0 (min (1- width) x1))
    (max 0 (min (1- height) y1))
    (max 0 (min (1- width) x2))
    (max 0 (min (1- height) y2))
    color))

(defun W2L:PreviewDiagonal (width height spacing offset color / start x1 y1 x2 y2)
  ;; Draw clipped down-right diagonals. OFFSET allows paired/triple patterns.
  (setq start (- offset height))
  (while (< start width)
    (if (< start 0)
      (setq x1 0 y1 (- start))
      (setq x1 start y1 0))
    (if (> (+ start (1- height)) (1- width))
      (setq x2 (1- width) y2 (- (1- width) start))
      (setq x2 (+ start (1- height)) y2 (1- height)))
    (if (and (>= y1 0) (< y1 height) (>= y2 0) (< y2 height))
      (W2L:PreviewLine width height x1 y1 x2 y2 color))
    (setq start (+ start spacing))))

(defun W2L:PreviewCross (width height x y size color)
  (W2L:PreviewLine width height (- x size) y (+ x size) y color)
  (W2L:PreviewLine width height x (- y size) x (+ y size) color))

(defun W2L:DrawHatchPreview (value / pattern width height x y row step color)
  (setq pattern (nth (atoi value) *W2L-HatchPatterns*)
        width   (dimx_tile "hatch_preview")
        height  (dimy_tile "hatch_preview")
        color   7)
  (if (and pattern (> width 2) (> height 2))
    (progn
      (start_image "hatch_preview")
      (fill_image 0 0 width height 0)
      (cond
        ((= pattern "SOLID")
         (fill_image 2 2 (- width 4) (- height 4) color))
        ((= pattern "ANSI31")
         (W2L:PreviewDiagonal width height 12 0 color))
        ((= pattern "ANSI32")
         (W2L:PreviewDiagonal width height 18 0 color)
         (W2L:PreviewDiagonal width height 18 3 color))
        ((= pattern "ANSI33")
         (W2L:PreviewDiagonal width height 22 0 color)
         (W2L:PreviewDiagonal width height 22 3 color)
         (W2L:PreviewDiagonal width height 22 6 color))
        ((= pattern "NET")
         (setq x 4)
         (while (< x width)
           (W2L:PreviewLine width height x 0 x (1- height) color)
           (setq x (+ x 10)))
         (setq y 4)
         (while (< y height)
           (W2L:PreviewLine width height 0 y (1- width) y color)
           (setq y (+ y 10))))
        ((= pattern "DOTS")
         (setq row 0 y 5)
         (while (< y height)
           (setq x (+ 5 (if (= (rem row 2) 0) 0 6)))
           (while (< x width)
             (W2L:PreviewCross width height x y 1 color)
             (setq x (+ x 12)))
           (setq row (1+ row) y (+ y 9))))
        ((= pattern "BRICK")
         (setq row 0 y 3)
         (while (< y height)
           (W2L:PreviewLine width height 0 y (1- width) y color)
           (setq x (+ 4 (if (= (rem row 2) 0) 0 11)))
           (while (< x width)
             (W2L:PreviewLine
               width height x y x (min (1- height) (+ y 10)) color)
             (setq x (+ x 22)))
           (setq row (1+ row) y (+ y 10))))
        ((= pattern "AR-B816")
         (setq row 0 y 3)
         (while (< y height)
           (W2L:PreviewLine width height 0 y (1- width) y color)
           (setq x (+ 3 (if (= (rem row 2) 0) 0 8)))
           (while (< x width)
             (W2L:PreviewLine
               width height x y x (min (1- height) (+ y 7)) color)
             (setq x (+ x 16)))
           (setq row (1+ row) y (+ y 7))))
        ((= pattern "EARTH")
         (setq y 5)
         (while (< y height)
           (W2L:PreviewLine width height 0 y (1- width) y color)
           (setq x 3)
           (while (< x width)
             (W2L:PreviewLine
               width height x y (min (1- width) (+ x 6))
               (min (1- height) (+ y 5)) color)
             (setq x (+ x 13)))
           (setq y (+ y 11))))
        ((= pattern "GRAVEL")
         (setq x 3 y 4 step 0)
         (while (< y height)
           (while (< x width)
             (W2L:PreviewLine
               width height x y (+ x 4) (max 0 (- y 2)) color)
             (W2L:PreviewLine
               width height (+ x 4) (max 0 (- y 2))
               (+ x 8) (+ y 1) color)
             (W2L:PreviewLine
               width height (+ x 8) (+ y 1) (+ x 5) (+ y 5) color)
             (W2L:PreviewLine
               width height (+ x 5) (+ y 5) x y color)
             (setq x (+ x 15)))
           (setq step (1+ step)
                 x (+ 3 (if (= (rem step 2) 0) 0 7))
                 y (+ y 10))))
        ((= pattern "AR-CONC")
         (setq x 4 y 5 step 0)
         (while (< y height)
           (while (< x width)
             (W2L:PreviewLine
               width height x y (+ x 7) (max 0 (- y 3)) color)
             (W2L:PreviewLine
               width height (+ x 2) (+ y 3) (+ x 9) (+ y 1) color)
             (W2L:PreviewCross width height (+ x 11) y 1 color)
             (setq x (+ x 19)))
           (setq step (1+ step)
                 x (+ 4 (if (= (rem step 2) 0) 0 9))
                 y (+ y 9))))
        (T
         (W2L:PreviewDiagonal width height 14 0 color)))
      ;; A light frame keeps SOLID and sparse previews visually bounded.
      (W2L:PreviewLine width height 0 0 (1- width) 0 8)
      (W2L:PreviewLine width height (1- width) 0
                       (1- width) (1- height) 8)
      (W2L:PreviewLine width height (1- width) (1- height)
                       0 (1- height) 8)
      (W2L:PreviewLine width height 0 (1- height) 0 0 8)
      (end_image))))

(defun W2L:ToggleHatchTiles (value / mode key)
  (setq mode (if (= value "1") 0 1))
  (foreach key
    '("hatch_pattern" "hatch_scale" "hatch_angle" "layer_hatch")
    (mode_tile key mode)))

(defun W2L:DialogAccept (/ core interior exterior scale angle pattern-index
                           core-layer interior-layer exterior-layer hatch-layer
                           create-layers)
  (setq core        (distof (get_tile "core_thk") 2)
        interior    (distof (get_tile "finish_in") 2)
        exterior    (distof (get_tile "finish_ex") 2)
        scale       (distof (get_tile "hatch_scale") 2)
        angle       (distof (get_tile "hatch_angle") 2)
        pattern-index (atoi (get_tile "hatch_pattern"))
        core-layer     (W2L:PopupValue "layer_core" *W2L-DialogLayers*)
        interior-layer (W2L:PopupValue "layer_in" *W2L-DialogLayers*)
        exterior-layer (W2L:PopupValue "layer_ex" *W2L-DialogLayers*)
        hatch-layer    (W2L:PopupValue "layer_hatch" *W2L-DialogLayers*)
        create-layers  (= (get_tile "create_layers") "1"))
  (cond
    ((or (null core) (<= core 0.0))
     (alert "Core thickness must be greater than zero."))
    ((or (null interior) (< interior 0.0)
         (null exterior) (< exterior 0.0))
     (alert "Finish thickness values must be zero or greater."))
    ((or (not (W2L:ValidLayerNameP core-layer))
         (not (W2L:ValidLayerNameP interior-layer))
         (not (W2L:ValidLayerNameP exterior-layer))
         (not (W2L:ValidLayerNameP hatch-layer)))
     (alert "Enter valid AutoCAD layer names."))
    ((and (not create-layers)
          (or (null (tblsearch "LAYER" core-layer))
              (null (tblsearch "LAYER" interior-layer))
              (null (tblsearch "LAYER" exterior-layer))
              (and (= (get_tile "make_hatch") "1")
                   (null (tblsearch "LAYER" hatch-layer)))))
     (alert "One or more output layers do not exist. Enable automatic layer creation or enter existing layer names."))
    ((and (= (get_tile "make_hatch") "1")
          (or (null scale) (<= scale 0.0)))
     (alert "Hatch scale must be greater than zero."))
    ((and (= (get_tile "make_hatch") "1") (null angle))
     (alert "Enter a valid hatch angle."))
    (T
     (setq *W2L-Thickness* core
           *W2L-InteriorFinish* interior
           *W2L-ExteriorFinish* exterior
           *W2L-Justification*
             (cond
               ((= (get_tile "just_left") "1") "Left")
               ((= (get_tile "just_right") "1") "Right")
               (T "Center"))
           *W2L-ExteriorSide*
             (if (= (get_tile "ext_right") "1") "Right" "Left")
           *W2L-CoreLayer* core-layer
           *W2L-InteriorLayer* interior-layer
           *W2L-ExteriorLayer* exterior-layer
           *W2L-HatchLayer* hatch-layer
           *W2L-AutoCreateLayers* create-layers
           *W2L-CreateHatch* (= (get_tile "make_hatch") "1")
           *W2L-HatchPattern* (nth pattern-index *W2L-HatchPatterns*)
           *W2L-HatchScale* (if scale scale *W2L-HatchScale*)
           *W2L-HatchAngle* (if angle angle *W2L-HatchAngle*)
           *W2L-NormalizePolylines* (= (get_tile "normalize") "1")
           *W2L-JoinContinuations* (= (get_tile "join_split") "1")
           *W2L-CleanCorners* (= (get_tile "clean_corner") "1")
           *W2L-CleanTJunctions* (= (get_tile "clean_t") "1")
           *W2L-CleanCrossings* (= (get_tile "clean_cross") "1")
           *W2L-CloseEnds* (= (get_tile "close_ends") "1")
           *W2L-KeepCenterlines* (= (get_tile "keep_center") "1"))
     (done_dialog 1))))

(defun W2L:ShowSettingsDialog (/ path dialog-id status pattern)
  (setq *W2L-DialogLayers* (W2L:BuildLayerChoices)
        path (W2L:WriteDialogFile))
  (if (and path (> (setq dialog-id (load_dialog path)) 0)
           (new_dialog "wall2line_panel" dialog-id))
    (progn
      (set_tile "core_thk" (rtos *W2L-Thickness* 2 4))
      (set_tile "finish_in" (rtos *W2L-InteriorFinish* 2 4))
      (set_tile "finish_ex" (rtos *W2L-ExteriorFinish* 2 4))
      (set_tile "just_center" (W2L:BoolTile (= *W2L-Justification* "Center")))
      (set_tile "just_left" (W2L:BoolTile (= *W2L-Justification* "Left")))
      (set_tile "just_right" (W2L:BoolTile (= *W2L-Justification* "Right")))
      (set_tile "ext_left" (W2L:BoolTile (= *W2L-ExteriorSide* "Left")))
      (set_tile "ext_right" (W2L:BoolTile (= *W2L-ExteriorSide* "Right")))
      (set_tile "keep_center" (W2L:BoolTile *W2L-KeepCenterlines*))
      (W2L:FillPopup "layer_core" *W2L-DialogLayers* *W2L-CoreLayer*)
      (W2L:FillPopup "layer_in" *W2L-DialogLayers* *W2L-InteriorLayer*)
      (W2L:FillPopup "layer_ex" *W2L-DialogLayers* *W2L-ExteriorLayer*)
      (W2L:FillPopup "layer_hatch" *W2L-DialogLayers* *W2L-HatchLayer*)
      (set_tile "create_layers" (W2L:BoolTile *W2L-AutoCreateLayers*))
      (set_tile "normalize" (W2L:BoolTile *W2L-NormalizePolylines*))
      (set_tile "join_split" (W2L:BoolTile *W2L-JoinContinuations*))
      (set_tile "clean_corner" (W2L:BoolTile *W2L-CleanCorners*))
      (set_tile "clean_t" (W2L:BoolTile *W2L-CleanTJunctions*))
      (set_tile "clean_cross" (W2L:BoolTile *W2L-CleanCrossings*))
      (set_tile "close_ends" (W2L:BoolTile *W2L-CloseEnds*))
      (set_tile "make_hatch" (W2L:BoolTile *W2L-CreateHatch*))
      (start_list "hatch_pattern")
      (foreach pattern *W2L-HatchPatterns* (add_list pattern))
      (end_list)
      (set_tile "hatch_pattern"
        (itoa (W2L:ListIndex *W2L-HatchPattern* *W2L-HatchPatterns*)))
      (set_tile "hatch_scale" (rtos *W2L-HatchScale* 2 4))
      (set_tile "hatch_angle" (rtos *W2L-HatchAngle* 2 4))
      (W2L:DrawHatchPreview (get_tile "hatch_pattern"))
      (W2L:ToggleHatchTiles (W2L:BoolTile *W2L-CreateHatch*))
      (action_tile "make_hatch" "(W2L:ToggleHatchTiles $value)")
      (action_tile "hatch_pattern" "(W2L:DrawHatchPreview $value)")
      (action_tile "accept" "(W2L:DialogAccept)")
      (action_tile "cancel" "(done_dialog 0)")
      (setq status (start_dialog)))
    (setq status 0))
  (if (and dialog-id (> dialog-id 0)) (unload_dialog dialog-id))
  (if path (vl-file-delete path))
  (= status 1))

;;; ---------------------------------------------------------------------------
;;; Output layers and core hatch generation
;;; ---------------------------------------------------------------------------

(defun W2L:EnsureLayer (name / document layers result)
  (if (tblsearch "LAYER" name)
    T
    (if *W2L-AutoCreateLayers*
      (progn
        (setq document (vla-get-ActiveDocument (vlax-get-acad-object))
              layers (vla-get-Layers document)
              result
                (vl-catch-all-apply 'vla-Add (list layers name)))
        (not (vl-catch-all-error-p result)))
      nil)))

(defun W2L:PrepareOutputLayers (/ names name ok)
  (setq names
         (list *W2L-CoreLayer* *W2L-InteriorLayer* *W2L-ExteriorLayer*)
        ok T)
  (if *W2L-CreateHatch*
    (setq names (append names (list *W2L-HatchLayer*))))
  (foreach name names
    (if (not (W2L:EnsureLayer name)) (setq ok nil)))
  ok)

(defun W2L:SetEntityLayer (ent layer / object result)
  (if (and ent (entget ent))
    (progn
      (setq object (vlax-ename->vla-object ent)
            result
              (vl-catch-all-apply 'vla-put-Layer (list object layer)))
      (not (vl-catch-all-error-p result)))))

(defun W2L:AssignWallLayers (core-left core-right outer-left outer-right
                             exterior-side / ok-1 ok-2 ok-3 ok-4)
  (setq ok-1 (W2L:SetEntityLayer core-left *W2L-CoreLayer*)
        ok-2 (W2L:SetEntityLayer core-right *W2L-CoreLayer*))
  (if (= exterior-side "Left")
    (setq ok-3 (W2L:SetEntityLayer outer-left *W2L-ExteriorLayer*)
          ok-4 (W2L:SetEntityLayer outer-right *W2L-InteriorLayer*))
    (setq ok-3 (W2L:SetEntityLayer outer-left *W2L-InteriorLayer*)
          ok-4 (W2L:SetEntityLayer outer-right *W2L-ExteriorLayer*)))
  (and ok-1 ok-2 ok-3 ok-4))

(defun W2L:CurrentSpace (/ document)
  (setq document (vla-get-ActiveDocument (vlax-get-acad-object)))
  (if (= (getvar "CVPORT") 1)
    (vla-get-PaperSpace document)
    (vla-get-ModelSpace document)))

(defun W2L:Points2DArray (points / values point array)
  (setq values nil)
  (foreach point points
    (setq values (append values (list (car point) (cadr point)))))
  (setq array
         (vlax-make-safearray
           vlax-vbDouble (cons 0 (1- (length values)))))
  (vlax-safearray-fill array values)
  array)

(defun W2L:CoreHatchPoints (record / left-start left-end right-end right-start)
  (if (= (W2L:RType record) "LINE")
    (progn
      (setq left-start
             (W2L:CurveEndNear (W2L:RLeft record) (W2L:RStart record))
            left-end
             (W2L:CurveEndNear (W2L:RLeft record) (W2L:REnd record))
            right-end
             (W2L:CurveEndNear (W2L:RRight record) (W2L:REnd record))
            right-start
             (W2L:CurveEndNear (W2L:RRight record) (W2L:RStart record)))
      (if (and left-start left-end right-end right-start)
        (list left-start left-end right-end right-start)))))

(defun W2L:AddCoreHatch (record pattern scale angle layer
                         / points space boundary loop hatch result success)
  (if (setq points (W2L:CoreHatchPoints record))
    (progn
      (setq space (W2L:CurrentSpace)
            boundary
              (vl-catch-all-apply
                'vla-AddLightWeightPolyline
                (list space (W2L:Points2DArray points))))
      (if (not (vl-catch-all-error-p boundary))
        (progn
          (vla-put-Closed boundary :vlax-true)
          (setq hatch
                 (vl-catch-all-apply
                   'vla-AddHatch
                   (list space 0 pattern :vlax-false 0)))
          (if (not (vl-catch-all-error-p hatch))
            (progn
              (setq loop (vlax-make-safearray vlax-vbObject '(0 . 0)))
              (vlax-safearray-put-element loop 0 boundary)
              (setq result
                     (vl-catch-all-apply
                       'vla-AppendOuterLoop (list hatch loop)))
              (if (not (vl-catch-all-error-p result))
                (progn
                  (vl-catch-all-apply 'vla-put-PatternScale (list hatch scale))
                  (vl-catch-all-apply
                    'vla-put-PatternAngle
                    (list hatch (* pi (/ angle 180.0))))
                  (vl-catch-all-apply 'vla-put-Layer (list hatch layer))
                  (setq result
                         (vl-catch-all-apply 'vla-Evaluate (list hatch)))
                  (if (not (vl-catch-all-error-p result))
                    (setq success (vlax-vla-object->ename hatch)))))))
          (vl-catch-all-apply 'vla-Delete (list boundary))
          (if (and hatch (not (vl-catch-all-error-p hatch)) (null success))
            (vl-catch-all-apply 'vla-Delete (list hatch)))
          (if success
            (vl-catch-all-apply
              'command-s (list "_.DRAWORDER" success "" "_Back")))))))
  success)

(defun W2L:CreateCoreHatches (records / created skipped record)
  (setq created 0 skipped 0)
  (foreach record records
    (if (W2L:AddCoreHatch
          record *W2L-HatchPattern* *W2L-HatchScale*
          *W2L-HatchAngle* *W2L-HatchLayer*)
      (setq created (1+ created))
      (setq skipped (1+ skipped))))
  (list created skipped))

;;; ---------------------------------------------------------------------------
;;; Source normalization
;;; ---------------------------------------------------------------------------

(defun W2L:ObjectList (value / raw)
  (cond
    ((listp value) value)
    ((= (type value) 'VARIANT)
     (W2L:ObjectList (vlax-variant-value value)))
    ((= (type value) 'SAFEARRAY)
     (vlax-safearray->list value))))

(defun W2L:ExplodePolyline (ent / object result objects child child-ent
                                children spawned valid)
  (setq object (vlax-ename->vla-object ent)
        result
          (vl-catch-all-apply
            'vla-Explode
            (list object)))
  (if (and (not (vl-catch-all-error-p result)) result)
    (progn
      (setq objects (W2L:ObjectList result)
            children nil
            spawned nil
            valid T)
      (foreach child objects
        (setq child-ent
               (cond
                 ((= (type child) 'ENAME) child)
                 ((= (type child) 'VLA-OBJECT)
                  (vlax-vla-object->ename child))))
        (if child-ent
          (setq spawned (cons child-ent spawned)))
        (if child-ent
          (if (and (entget child-ent)
                   (member
                     (cdr (assoc 0 (entget child-ent))) '("LINE" "ARC")))
            (setq children (cons child-ent children))
            (setq valid nil))
          (setq valid nil)))
      (setq children (reverse children))
      (if (and valid children)
        (progn
          (entdel ent)
          children)
        (progn
          ;; A failed or unsupported explosion must not leave duplicates.
          (foreach child-ent spawned
            (if (entget child-ent) (entdel child-ent)))
          nil)))))

(defun W2L:NormalizeSelection (selection / index ent data object-type pieces
                                         sources polyline-count)
  (setq index 0 sources nil polyline-count 0)
  (repeat (sslength selection)
    (setq ent         (ssname selection index)
          index       (1+ index)
          data        (entget ent)
          object-type (cdr (assoc 0 data)))
    (if (member object-type '("LWPOLYLINE" "POLYLINE"))
      (if (setq pieces (W2L:ExplodePolyline ent))
        (progn
          (foreach ent pieces
            (setq sources (cons ent sources)))
          (setq polyline-count (1+ polyline-count)))
        ;; Keep the original if AutoCAD cannot safely normalize it.
        (setq sources (cons ent sources)))
      (setq sources (cons ent sources))))
  (list (reverse sources) polyline-count))

(defun W2L:SelectionEntities (selection / index entities)
  (setq index 0 entities nil)
  (repeat (sslength selection)
    (setq entities (cons (ssname selection index) entities)
          index (1+ index)))
  (reverse entities))

(defun W2L:SidePoint (ent side clearance / obj end-param total-dist sample-dist
                          sample-param point tangent tangent-length side-sign)
  (setq obj (vlax-ename->vla-object ent))
  (setq end-param (vl-catch-all-apply 'vlax-curve-getEndParam (list obj)))

  (if (not (vl-catch-all-error-p end-param))
    (progn
      (setq total-dist
             (vl-catch-all-apply
               'vlax-curve-getDistAtParam
               (list obj end-param)))

      (if (and (not (vl-catch-all-error-p total-dist))
               total-dist
               (> total-dist 1.0e-9))
        (progn
          ;; An off-center sample avoids landing exactly on a polyline vertex
          ;; in many common, symmetrical wall paths.
          (setq sample-dist (* total-dist 0.371))
          (setq point
                 (vl-catch-all-apply
                   'vlax-curve-getPointAtDist
                   (list obj sample-dist)))
          (setq sample-param
                 (vl-catch-all-apply
                   'vlax-curve-getParamAtDist
                   (list obj sample-dist)))

          (if (and (not (vl-catch-all-error-p point))
                   point
                   (not (vl-catch-all-error-p sample-param))
                   sample-param)
            (progn
              (setq tangent
                     (vl-catch-all-apply
                       'vlax-curve-getFirstDeriv
                       (list obj sample-param)))

              (if (and (not (vl-catch-all-error-p tangent)) tangent)
                (progn
                  ;; Curve functions return WCS data. OFFSET receives the
                  ;; side point in the current UCS, so both are transformed.
                  (setq point   (trans point 0 1)
                        tangent (trans tangent 0 1 T)
                        tangent-length
                          (sqrt
                            (+ (* (car tangent) (car tangent))
                               (* (cadr tangent) (cadr tangent))))
                        side-sign (if (= side "Left") 1.0 -1.0))

                  (if (> tangent-length 1.0e-12)
                    (list
                      (+ (car point)
                         (* side-sign clearance
                            (/ (- (cadr tangent)) tangent-length)))
                      (+ (cadr point)
                         (* side-sign clearance
                            (/ (car tangent) tangent-length)))
                      (if (caddr point) (caddr point) 0.0))))))))))))

(defun W2L:OffsetOne (ent distance side / side-point before after result copy)
  ;; A zero finish thickness still needs a separate coincident output entity
  ;; so its layer can differ from the adjacent core face.
  (if (<= (abs distance) 1.0e-12)
    (progn
      (setq copy
             (vl-catch-all-apply
               'vla-Copy (list (vlax-ename->vla-object ent))))
      (if (not (vl-catch-all-error-p copy))
        (vlax-vla-object->ename copy)))
    (progn
      (setq side-point
             (W2L:SidePoint
               ent
               side
               (max (* distance 2.0) 1.0e-6)))
      (if side-point
        (progn
          (setq before (entlast))

          ;; Erase=No protects the source object. Layer=Source preserves its layer.
          (setq result
                 (vl-catch-all-apply
                   'command-s
                   (list "_.OFFSET"
                         "_Erase" "_No"
                         "_Layer" "_Source"
                         distance ent side-point "")))

          (setq after (entlast))

          (if (and (not (vl-catch-all-error-p result))
                   after
                   (not (equal before after))
                   (entget after))
            after))))))

;;; ---------------------------------------------------------------------------
;;; Geometry and source-network helpers
;;; ---------------------------------------------------------------------------

(defun W2L:V+ (a b)
  (list (+ (car a) (car b))
        (+ (cadr a) (cadr b))
        (+ (if (caddr a) (caddr a) 0.0)
           (if (caddr b) (caddr b) 0.0))))

(defun W2L:V- (a b)
  (list (- (car a) (car b))
        (- (cadr a) (cadr b))
        (- (if (caddr a) (caddr a) 0.0)
           (if (caddr b) (caddr b) 0.0))))

(defun W2L:V* (v factor)
  (list (* (car v) factor)
        (* (cadr v) factor)
        (* (if (caddr v) (caddr v) 0.0) factor)))

(defun W2L:Dot2 (a b)
  (+ (* (car a) (car b)) (* (cadr a) (cadr b))))

(defun W2L:Cross2 (a b)
  (- (* (car a) (cadr b)) (* (cadr a) (car b))))

(defun W2L:Length2 (v)
  (sqrt (W2L:Dot2 v v)))

(defun W2L:Unit2 (v / length)
  (setq length (W2L:Length2 v))
  (if (> length 1.0e-12)
    (list (/ (car v) length) (/ (cadr v) length) 0.0)))

(defun W2L:Distance2 (a b)
  (W2L:Length2 (W2L:V- a b)))

(defun W2L:MidPoint (a b)
  (W2L:V* (W2L:V+ a b) 0.5))

;;; Record:
;;; (source start end core-left core-right outer-left outer-right
;;;  source-type closed-p free-start-p free-end-p)
(defun W2L:RSource (record) (nth 0 record))
(defun W2L:RStart  (record) (nth 1 record))
(defun W2L:REnd    (record) (nth 2 record))
(defun W2L:RLeft   (record) (nth 3 record))
(defun W2L:RRight  (record) (nth 4 record))
(defun W2L:ROuterLeft  (record) (nth 5 record))
(defun W2L:ROuterRight (record) (nth 6 record))
(defun W2L:RType       (record) (nth 7 record))
(defun W2L:RClosed     (record) (nth 8 record))
(defun W2L:RFreeStart  (record) (nth 9 record))
(defun W2L:RFreeEnd    (record) (nth 10 record))

(defun W2L:RAllFaces (record)
  (list (W2L:ROuterLeft record)
        (W2L:RLeft record)
        (W2L:RRight record)
        (W2L:ROuterRight record)))

(defun W2L:LinePoints (ent / data)
  (if (and ent
           (setq data (entget ent))
           (= (cdr (assoc 0 data)) "LINE"))
    (list (cdr (assoc 10 data)) (cdr (assoc 11 data)))))

(defun W2L:LineIntersection (ent-a ent-b / points-a points-b)
  (if (and (setq points-a (W2L:LinePoints ent-a))
           (setq points-b (W2L:LinePoints ent-b)))
    ;; nil makes INTERS use the infinite extensions of both lines.
    (inters (car points-a) (cadr points-a)
            (car points-b) (cadr points-b) nil)))

(defun W2L:SetLineEndNear (ent reference-point new-point / data start end old-pair)
  (if (and (setq data (entget ent))
           (= (cdr (assoc 0 data)) "LINE"))
    (progn
      (setq start (cdr (assoc 10 data))
            end   (cdr (assoc 11 data)))
      (if (<= (W2L:Distance2 start reference-point)
              (W2L:Distance2 end reference-point))
        (setq old-pair (assoc 10 data))
        (setq old-pair (assoc 11 data)))
      (if (entmod (subst (cons (car old-pair) new-point) old-pair data))
        (progn (entupd ent) T)))))

(defun W2L:SetLineGeometry (ent start end / obj result-a result-b)
  (if (and ent (entget ent))
    (progn
      (setq obj (vlax-ename->vla-object ent)
            result-a
              (vl-catch-all-apply
                'vla-put-StartPoint
                (list obj (vlax-3d-point start)))
            result-b
              (vl-catch-all-apply
                'vla-put-EndPoint
                (list obj (vlax-3d-point end))))
      (if (and (not (vl-catch-all-error-p result-a))
               (not (vl-catch-all-error-p result-b)))
        (progn (vla-Update obj) T)))))

(defun W2L:CopyLineGeometry (ent start end / source copy result-a result-b)
  (if (and ent (entget ent))
    (progn
      (setq source (vlax-ename->vla-object ent)
            copy   (vl-catch-all-apply 'vla-Copy (list source)))
      (if (not (vl-catch-all-error-p copy))
        (progn
          (setq result-a
                 (vl-catch-all-apply
                   'vla-put-StartPoint
                   (list copy (vlax-3d-point start)))
                result-b
                 (vl-catch-all-apply
                   'vla-put-EndPoint
                   (list copy (vlax-3d-point end))))
          (if (and (not (vl-catch-all-error-p result-a))
                   (not (vl-catch-all-error-p result-b)))
            (progn
              (vla-Update copy)
              (vlax-vla-object->ename copy))))))))

(defun W2L:CurveStartPoint (ent / result)
  (setq result
         (vl-catch-all-apply 'vlax-curve-getStartPoint (list ent)))
  (if (not (vl-catch-all-error-p result)) result))

(defun W2L:CurveEndPoint (ent / result)
  (setq result
         (vl-catch-all-apply 'vlax-curve-getEndPoint (list ent)))
  (if (not (vl-catch-all-error-p result)) result))

(defun W2L:CurveClosedP (ent / result)
  (setq result
         (vl-catch-all-apply 'vlax-curve-isClosed (list ent)))
  (if (vl-catch-all-error-p result) nil result))

(defun W2L:CurveEndNear (ent reference-point / start end)
  (if (and (setq start (W2L:CurveStartPoint ent))
           (setq end   (W2L:CurveEndPoint ent)))
    (if (<= (W2L:Distance2 start reference-point)
            (W2L:Distance2 end reference-point))
      start
      end)))

(defun W2L:CurveContainsPointP (ent point tolerance / closest)
  (setq closest
         (vl-catch-all-apply
           'vlax-curve-getClosestPointTo
           (list ent point)))
  (and (not (vl-catch-all-error-p closest))
       closest
       (<= (W2L:Distance2 closest point) tolerance)))

(defun W2L:SourceNodeDegree (point source-entities tolerance / count ent)
  (setq count 0)
  (foreach ent source-entities
    (if (and (entget ent)
             (W2L:CurveContainsPointP ent point tolerance))
      (setq count (1+ count))))
  count)

(defun W2L:EndpointConnectedP (record point records snap-tolerance
                               junction-tolerance / connected other)
  ;; Check a split-host node once, then fall back to direct connections.
  (setq connected
         (if (W2L:FindThroughPair
               point records snap-tolerance junction-tolerance)
           T
           nil))
  (foreach other records
    (if (and (not connected)
             (not (equal (W2L:RSource record) (W2L:RSource other))))
      (if (or
            ;; Ordinary corners and collinear continuations meet endpoint to
            ;; endpoint and only need the smaller drafting snap tolerance.
            (<= (W2L:Distance2 point (W2L:RStart other)) snap-tolerance)
            (<= (W2L:Distance2 point (W2L:REnd other)) snap-tolerance)
            ;; T branches may stop at a finished face of a nonparallel host.
            (and (= (W2L:RType record) "LINE")
                 (= (W2L:RType other) "LINE")
                 (not (W2L:ParallelRecordsP record other))
                 (W2L:PointOnSegmentInteriorP
                   point (W2L:RStart other) (W2L:REnd other)
                   junction-tolerance)))
        (setq connected T))))
  connected)

(defun W2L:AddFreeFlags (record records snap-tolerance junction-tolerance
                         / free-start free-end)
  (setq free-start nil free-end nil)
  (if (not (W2L:RClosed record))
    (setq free-start
           (not
             (W2L:EndpointConnectedP
               record (W2L:RStart record) records
               snap-tolerance junction-tolerance))
          free-end
           (not
             (W2L:EndpointConnectedP
               record (W2L:REnd record) records
               snap-tolerance junction-tolerance))))
  (append record (list free-start free-end)))

(defun W2L:AddCapLine (template-ent point-a point-b / doc space template line)
  (if (and point-a point-b (> (W2L:Distance2 point-a point-b) 1.0e-9))
    (progn
      (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
            space
              (if (= (getvar "CVPORT") 1)
                (vla-get-PaperSpace doc)
                (vla-get-ModelSpace doc))
            template (vlax-ename->vla-object template-ent)
            line
              (vla-AddLine
                space (vlax-3d-point point-a) (vlax-3d-point point-b)))
      ;; Match the visible properties of the longitudinal wall lines.
      (vl-catch-all-apply 'vla-put-Layer
        (list line (vla-get-Layer template)))
      (vl-catch-all-apply 'vla-put-Color
        (list line (vla-get-Color template)))
      (vl-catch-all-apply 'vla-put-Linetype
        (list line (vla-get-Linetype template)))
      (vl-catch-all-apply 'vla-put-LinetypeScale
        (list line (vla-get-LinetypeScale template)))
      (vl-catch-all-apply 'vla-put-Lineweight
        (list line (vla-get-Lineweight template)))
      (vla-Update line)
      (vlax-vla-object->ename line))))

(defun W2L:CloseFreeEnds (records / count record point-left point-right)
  (setq count 0)
  (foreach record records
    (if (W2L:RFreeStart record)
      (progn
        (setq point-left
               (W2L:CurveEndNear
                 (W2L:ROuterLeft record) (W2L:RStart record))
              point-right
               (W2L:CurveEndNear
                 (W2L:ROuterRight record) (W2L:RStart record)))
        (if (W2L:AddCapLine (W2L:ROuterLeft record) point-left point-right)
          (setq count (1+ count)))))
    (if (W2L:RFreeEnd record)
      (progn
        (setq point-left
               (W2L:CurveEndNear
                 (W2L:ROuterLeft record) (W2L:REnd record))
              point-right
               (W2L:CurveEndNear
                 (W2L:ROuterRight record) (W2L:REnd record)))
        (if (W2L:AddCapLine (W2L:ROuterLeft record) point-left point-right)
          (setq count (1+ count)))))
  count))

(defun W2L:PointSegmentData (point start end / vector length-squared parameter closest)
  (setq vector (W2L:V- end start)
        length-squared (W2L:Dot2 vector vector))
  (if (> length-squared 1.0e-18)
    (progn
      (setq parameter
             (/ (W2L:Dot2 (W2L:V- point start) vector)
                length-squared)
            closest (W2L:V+ start (W2L:V* vector parameter)))
      (list parameter (W2L:Distance2 point closest)))))

(defun W2L:PointOnSegmentP (point start end tolerance / data)
  (if (setq data (W2L:PointSegmentData point start end))
    (and (>= (car data) 0.0)
         (<= (car data) 1.0)
         (<= (cadr data) tolerance))))

(defun W2L:PointOnSegmentInteriorP (point start end tolerance / data epsilon)
  (if (setq data (W2L:PointSegmentData point start end))
    (progn
      ;; Keep the endpoint exclusion numerical; tolerance controls only the
      ;; perpendicular connection distance.
      (setq epsilon 1.0e-8)
      (and (> (car data) epsilon)
           (< (car data) (- 1.0 epsilon))
           (<= (cadr data) tolerance)))))

(defun W2L:NodeDegree (point records tolerance / count record)
  (setq count 0)
  (foreach record records
    (if (W2L:PointOnSegmentP
          point (W2L:RStart record) (W2L:REnd record) tolerance)
      (setq count (1+ count))))
  count)

(defun W2L:SharedEndpoint (record-a record-b tolerance / a-start a-end b-start b-end)
  (setq a-start (W2L:RStart record-a)
        a-end   (W2L:REnd record-a)
        b-start (W2L:RStart record-b)
        b-end   (W2L:REnd record-b))
  (cond
    ((<= (W2L:Distance2 a-start b-start) tolerance)
     (list 'Start 'Start (W2L:MidPoint a-start b-start)))
    ((<= (W2L:Distance2 a-start b-end) tolerance)
     (list 'Start 'End (W2L:MidPoint a-start b-end)))
    ((<= (W2L:Distance2 a-end b-start) tolerance)
     (list 'End 'Start (W2L:MidPoint a-end b-start)))
    ((<= (W2L:Distance2 a-end b-end) tolerance)
     (list 'End 'End (W2L:MidPoint a-end b-end)))))

(defun W2L:ParallelRecordsP (record-a record-b / vector-a vector-b denominator)
  (setq vector-a (W2L:V- (W2L:REnd record-a) (W2L:RStart record-a))
        vector-b (W2L:V- (W2L:REnd record-b) (W2L:RStart record-b))
        denominator (* (W2L:Length2 vector-a) (W2L:Length2 vector-b)))
  (if (> denominator 1.0e-18)
    (< (/ (abs (W2L:Cross2 vector-a vector-b)) denominator) 1.0e-8)
    T))

;;; ---------------------------------------------------------------------------
;;; Corner cleanup: geometric equivalent of FILLET with radius zero
;;; ---------------------------------------------------------------------------

(defun W2L:JoinCollinearBoundaryPair (ent-a ent-b reference-point
                                      / point-a point-b joint ok-a ok-b)
  (if (and (setq point-a (W2L:CurveEndNear ent-a reference-point))
           (setq point-b (W2L:CurveEndNear ent-b reference-point)))
    (progn
      (setq joint (W2L:MidPoint point-a point-b)
            ok-a (W2L:SetLineEndNear ent-a reference-point joint)
            ok-b (W2L:SetLineEndNear ent-b reference-point joint))
      (and ok-a ok-b))))

(defun W2L:CleanCollinearContinuations (records tolerance
                                        / count i j record-a record-b shared
                                          same-direction ok-1 ok-2 ok-3 ok-4)
  (setq count 0 i 0)
  (while (< i (length records))
    (setq record-a (nth i records)
          j (1+ i))
    (while (< j (length records))
      (setq record-b (nth j records)
            shared (W2L:SharedEndpoint record-a record-b tolerance))
      (if (and shared
               (W2L:OppositeAtNodeP record-a record-b (caddr shared)))
        (progn
          (setq same-direction (not (eq (car shared) (cadr shared))))
          (if same-direction
            (setq ok-1
                   (W2L:JoinCollinearBoundaryPair
                     (W2L:ROuterLeft record-a)
                     (W2L:ROuterLeft record-b) (caddr shared))
                  ok-2
                   (W2L:JoinCollinearBoundaryPair
                     (W2L:RLeft record-a)
                     (W2L:RLeft record-b) (caddr shared))
                  ok-3
                   (W2L:JoinCollinearBoundaryPair
                     (W2L:RRight record-a)
                     (W2L:RRight record-b) (caddr shared))
                  ok-4
                   (W2L:JoinCollinearBoundaryPair
                     (W2L:ROuterRight record-a)
                     (W2L:ROuterRight record-b) (caddr shared)))
            (setq ok-1
                   (W2L:JoinCollinearBoundaryPair
                     (W2L:ROuterLeft record-a)
                     (W2L:ROuterRight record-b) (caddr shared))
                  ok-2
                   (W2L:JoinCollinearBoundaryPair
                     (W2L:RLeft record-a)
                     (W2L:RRight record-b) (caddr shared))
                  ok-3
                   (W2L:JoinCollinearBoundaryPair
                     (W2L:RRight record-a)
                     (W2L:RLeft record-b) (caddr shared))
                  ok-4
                   (W2L:JoinCollinearBoundaryPair
                     (W2L:ROuterRight record-a)
                     (W2L:ROuterLeft record-b) (caddr shared))))
          (if (and ok-1 ok-2 ok-3 ok-4)
            (setq count (1+ count)))))
      (setq j (1+ j)))
    (setq i (1+ i)))
  count)

(defun W2L:MiterBoundaryPair (ent-a ent-b reference-point / intersection)
  (if (setq intersection (W2L:LineIntersection ent-a ent-b))
    (if (W2L:SetLineEndNear ent-a reference-point intersection)
      (W2L:SetLineEndNear ent-b reference-point intersection))))

(defun W2L:CleanCorners (records tolerance / count i j record-a record-b shared
                                 ok-1 ok-2 ok-3 ok-4 same-direction)
  (setq count 0 i 0)
  (while (< i (length records))
    (setq record-a (nth i records)
          j (1+ i))
    (while (< j (length records))
      (setq record-b (nth j records)
            shared (W2L:SharedEndpoint record-a record-b tolerance))
      ;; Only degree-2 nodes are ordinary corners. Higher-degree nodes are
      ;; junctions and must not be pairwise mitered.
      (if (and shared
               (= (W2L:NodeDegree (caddr shared) records tolerance) 2)
               (not (W2L:ParallelRecordsP record-a record-b)))
        (progn
          (setq same-direction (not (eq (car shared) (cadr shared))))
          (if same-direction
            (progn
              (setq ok-1
                     (W2L:MiterBoundaryPair
                       (W2L:ROuterLeft record-a)
                       (W2L:ROuterLeft record-b) (caddr shared))
                    ok-2
                     (W2L:MiterBoundaryPair
                       (W2L:RLeft record-a) (W2L:RLeft record-b) (caddr shared))
                    ok-3
                     (W2L:MiterBoundaryPair
                       (W2L:RRight record-a) (W2L:RRight record-b) (caddr shared))
                    ok-4
                     (W2L:MiterBoundaryPair
                       (W2L:ROuterRight record-a)
                       (W2L:ROuterRight record-b) (caddr shared))))
            (progn
              (setq ok-1
                     (W2L:MiterBoundaryPair
                       (W2L:ROuterLeft record-a)
                       (W2L:ROuterRight record-b) (caddr shared))
                    ok-2
                     (W2L:MiterBoundaryPair
                       (W2L:RLeft record-a) (W2L:RRight record-b) (caddr shared))
                    ok-3
                     (W2L:MiterBoundaryPair
                       (W2L:RRight record-a) (W2L:RLeft record-b) (caddr shared))
                    ok-4
                     (W2L:MiterBoundaryPair
                       (W2L:ROuterRight record-a)
                       (W2L:ROuterLeft record-b) (caddr shared)))))
          (if (and ok-1 ok-2 ok-3 ok-4)
            (setq count (1+ count)))))
      (setq j (1+ j)))
    (setq i (1+ i)))
  count)

;;; ---------------------------------------------------------------------------
;;; T-junction cleanup
;;; ---------------------------------------------------------------------------

(defun W2L:HostFaceCandidate (host-face branch-outer-left branch-outer-right
                              junction interior-unit
                              / point-left point-right middle score)
  (if (and (setq point-left
                  (W2L:LineIntersection host-face branch-outer-left))
           (setq point-right
                  (W2L:LineIntersection host-face branch-outer-right)))
    (progn
      (setq middle (W2L:MidPoint point-left point-right)
            score  (W2L:Dot2 (W2L:V- middle junction) interior-unit))
      (list host-face point-left point-right score))))

(defun W2L:HostSideData (host branch junction endpoint-kind
                         / other-point interior-unit branch-outer-left
                           branch-outer-right candidate-left candidate-right chosen)
  (setq other-point
         (if (eq endpoint-kind 'Start)
           (W2L:REnd branch)
           (W2L:RStart branch))
        interior-unit (W2L:Unit2 (W2L:V- other-point junction))
        branch-outer-left  (W2L:ROuterLeft branch)
        branch-outer-right (W2L:ROuterRight branch))
  (if interior-unit
    (progn
      (setq candidate-left
             (W2L:HostFaceCandidate
               (W2L:ROuterLeft host)
               branch-outer-left branch-outer-right junction interior-unit)
            candidate-right
             (W2L:HostFaceCandidate
               (W2L:ROuterRight host)
               branch-outer-left branch-outer-right junction interior-unit))
      (cond
        ((and candidate-left candidate-right)
         (setq chosen
                (if (>= (nth 3 candidate-left) (nth 3 candidate-right))
                  candidate-left
                  candidate-right)))
        (candidate-left  (setq chosen candidate-left))
        (candidate-right (setq chosen candidate-right)))
      (if chosen
        (if (equal (car chosen) (W2L:ROuterLeft host))
          (list (W2L:ROuterLeft host) (W2L:RLeft host))
          (list (W2L:ROuterRight host) (W2L:RRight host)))))))

(defun W2L:HostCutsForBranch (host branch junction endpoint-kind
                              / side-data outer-face core-face point-a point-b
                                outer-cut core-cut)
  (if (setq side-data
             (W2L:HostSideData host branch junction endpoint-kind))
    (progn
      (setq outer-face (car side-data)
            core-face  (cadr side-data)
            point-a
              (W2L:LineIntersection outer-face (W2L:ROuterLeft branch))
            point-b
              (W2L:LineIntersection outer-face (W2L:ROuterRight branch)))
      (if (and point-a point-b)
        (setq outer-cut (list outer-face point-a point-b)))
      (setq point-a
             (W2L:LineIntersection core-face (W2L:RLeft branch))
            point-b
             (W2L:LineIntersection core-face (W2L:RRight branch)))
      (if (and point-a point-b)
        (setq core-cut (list core-face point-a point-b)))
      (if (and outer-cut core-cut)
        (list outer-cut core-cut)))))

(defun W2L:CleanOneTJunction (branch host junction endpoint-kind
                              / side-data outer-face core-face target-pairs
                                target intersection intersections cuts all-ok pair)
  (if (setq side-data
             (W2L:HostSideData host branch junction endpoint-kind))
    (progn
      (setq outer-face (car side-data)
            core-face  (cadr side-data)
            target-pairs
              (list
                (list (W2L:ROuterLeft branch) outer-face)
                (list (W2L:RLeft branch) core-face)
                (list (W2L:RRight branch) core-face)
                (list (W2L:ROuterRight branch) outer-face))
            intersections nil
            cuts
              (W2L:HostCutsForBranch
                host branch junction endpoint-kind)
            all-ok (if cuts T nil))
      ;; Finish boundaries terminate at the near finished face; core
      ;; boundaries terminate at the near core face.
      (foreach target target-pairs
        (if (setq intersection
                   (W2L:LineIntersection (cadr target) (car target)))
          (setq intersections
                 (cons (list (car target) intersection) intersections))
          (setq all-ok nil)))
      (if all-ok
        (progn
          (foreach pair intersections
            (if (not
                  (W2L:SetLineEndNear
                    (car pair) junction (cadr pair)))
              (setq all-ok nil)))
          (if all-ok cuts))))))

(defun W2L:AddCut (cuts ent point-a point-b / item replacement)
  (if (setq item (assoc ent cuts))
    (progn
      (setq replacement
             (cons ent (cons (list point-a point-b) (cdr item))))
      (subst replacement item cuts))
    (cons (cons ent (list (list point-a point-b))) cuts)))

(defun W2L:CrossCutForFace (face cutter-a cutter-b / point-a point-b)
  (setq point-a (W2L:LineIntersection face cutter-a)
        point-b (W2L:LineIntersection face cutter-b))
  (if (and point-a point-b)
    (list face point-a point-b)))

(defun W2L:LayeredCrossCuts (record-a record-b / specifications cuts all-ok
                                                       specification cut)
  ;; Finished faces are interrupted by the other wall's finished width;
  ;; core faces are interrupted only by the other wall's core width.
  (setq specifications
         (list
           (list (W2L:ROuterLeft record-a)
                 (W2L:ROuterLeft record-b) (W2L:ROuterRight record-b))
           (list (W2L:ROuterRight record-a)
                 (W2L:ROuterLeft record-b) (W2L:ROuterRight record-b))
           (list (W2L:RLeft record-a)
                 (W2L:RLeft record-b) (W2L:RRight record-b))
           (list (W2L:RRight record-a)
                 (W2L:RLeft record-b) (W2L:RRight record-b))
           (list (W2L:ROuterLeft record-b)
                 (W2L:ROuterLeft record-a) (W2L:ROuterRight record-a))
           (list (W2L:ROuterRight record-b)
                 (W2L:ROuterLeft record-a) (W2L:ROuterRight record-a))
           (list (W2L:RLeft record-b)
                 (W2L:RLeft record-a) (W2L:RRight record-a))
           (list (W2L:RRight record-b)
                 (W2L:RLeft record-a) (W2L:RRight record-a)))
        cuts nil
        all-ok T)
  (foreach specification specifications
    (if (setq cut
               (W2L:CrossCutForFace
                 (car specification) (cadr specification) (caddr specification)))
      (setq cuts (cons cut cuts))
      (setq all-ok nil)))
  (if all-ok (reverse cuts)))

(defun W2L:SourceIntersection (record-a record-b)
  (inters (W2L:RStart record-a) (W2L:REnd record-a)
          (W2L:RStart record-b) (W2L:REnd record-b) T))

(defun W2L:CleanCrossings (records cuts tolerance
                           / crossing-count count i j record-a record-b
                             intersection cross-cuts cut)
  (setq crossing-count 0
        count (length records)
        i 0)
  (while (< i count)
    (setq record-a (nth i records)
          j (1+ i))
    (while (< j count)
      (setq record-b (nth j records)
            intersection nil
            cross-cuts nil)
      (if (and (not (W2L:ParallelRecordsP record-a record-b))
               (setq intersection
                      (W2L:SourceIntersection record-a record-b))
               (W2L:PointOnSegmentInteriorP
                 intersection (W2L:RStart record-a) (W2L:REnd record-a)
                 tolerance)
               (W2L:PointOnSegmentInteriorP
                 intersection (W2L:RStart record-b) (W2L:REnd record-b)
                 tolerance)
               (setq cross-cuts
                      (W2L:LayeredCrossCuts record-a record-b)))
        (progn
          (foreach cut cross-cuts
            (setq cuts
                   (W2L:AddCut cuts (car cut) (cadr cut) (caddr cut))))
          (setq crossing-count (1+ crossing-count))))
      (setq j (1+ j)))
    (setq i (1+ i)))
  (list crossing-count cuts))

(defun W2L:FindTJunctionHost (branch junction records tolerance
                              / best best-distance host data epsilon)
  (setq best nil best-distance nil epsilon 1.0e-8)
  (foreach host records
    (if (and (not (equal (W2L:RSource branch) (W2L:RSource host)))
             (not (W2L:ParallelRecordsP branch host))
             (setq data
                    (W2L:PointSegmentData
                      junction (W2L:RStart host) (W2L:REnd host))))
      (progn
        ;; The source endpoint may stop at a host face rather than exactly on
        ;; its centerline.  Projection inside the host plus a wall-scaled
        ;; distance is therefore the reliable T-junction test.
        (if (and (> (car data) epsilon)
                 (< (car data) (- 1.0 epsilon))
                 (<= (cadr data) tolerance)
                 (or (null best-distance)
                     (< (cadr data) best-distance)))
          (setq best host
                best-distance (cadr data))))))
  best)

(defun W2L:EndpointHasMateP (branch junction records tolerance / found other)
  (setq found nil)
  (foreach other records
    (if (and (not found)
             (not (equal (W2L:RSource branch) (W2L:RSource other)))
             (or (<= (W2L:Distance2 junction (W2L:RStart other)) tolerance)
                 (<= (W2L:Distance2 junction (W2L:REnd other)) tolerance)))
      (setq found T)))
  found)

(defun W2L:IncidentRecords (junction records tolerance / incident record)
  (setq incident nil)
  (foreach record records
    (if (or (<= (W2L:Distance2 junction (W2L:RStart record)) tolerance)
            (<= (W2L:Distance2 junction (W2L:REnd record)) tolerance))
      (setq incident (cons record incident))))
  (reverse incident))

(defun W2L:DirectionFromNode (record junction / other-point)
  (setq other-point
         (if (<= (W2L:Distance2 junction (W2L:RStart record))
                 (W2L:Distance2 junction (W2L:REnd record)))
           (W2L:REnd record)
           (W2L:RStart record)))
  (W2L:Unit2 (W2L:V- other-point junction)))

(defun W2L:OppositeAtNodeP (record-a record-b junction / direction-a direction-b)
  (setq direction-a (W2L:DirectionFromNode record-a junction)
        direction-b (W2L:DirectionFromNode record-b junction))
  (and direction-a direction-b
       (W2L:ParallelRecordsP record-a record-b)
       (< (W2L:Dot2 direction-a direction-b) -0.999)))

(defun W2L:FindThroughPair (junction records snap-tolerance junction-tolerance
                            / candidates best best-distance best-score count i j record-a
                              record-b shared node distance score)
  (setq candidates
          (W2L:IncidentRecords junction records junction-tolerance)
        best          nil
        best-distance nil
        best-score    nil
        count         (length candidates)
        i          0)
  (while (< i count)
    (setq record-a (nth i candidates)
          j (1+ i))
    (while (< j count)
      (setq record-b (nth j candidates)
            shared
              (W2L:SharedEndpoint
                record-a record-b snap-tolerance))
      (if (and shared
               (setq node (caddr shared))
               (<= (setq distance (W2L:Distance2 junction node))
                   junction-tolerance)
               (W2L:OppositeAtNodeP record-a record-b node))
        (progn
          ;; At a four-way node the longer through axis becomes the host.
          ;; This keeps the decision deterministic and prevents both axes
          ;; from cutting one another into a central hole.
          (setq score
                 (+ (W2L:Distance2 (W2L:RStart record-a) (W2L:REnd record-a))
                    (W2L:Distance2 (W2L:RStart record-b) (W2L:REnd record-b))))
          (if (or (null best-distance)
                  (< distance (- best-distance 1.0e-8))
                  (and (equal distance best-distance 1.0e-8)
                       (> score best-score)))
            (setq best (list record-a record-b)
                  best-distance distance
                  best-score score))))
      (setq j (1+ j)))
    (setq i (1+ i)))
  best)

(defun W2L:RecordInPairP (record pair)
  (or (equal (W2L:RSource record) (W2L:RSource (car pair)))
      (equal (W2L:RSource record) (W2L:RSource (cadr pair)))))

(defun W2L:CleanTJunctions (records snap-tolerance junction-tolerance
                            / junction-count cuts branch host endpoint junction
                              through-pair extra-cuts result cut)
  (setq junction-count 0 cuts nil)
  (foreach branch records
    (foreach endpoint
      (list (list 'Start (W2L:RStart branch))
            (list 'End   (W2L:REnd branch)))
      (setq junction (cadr endpoint)
            host nil
            through-pair
              (W2L:FindThroughPair
                junction records snap-tolerance junction-tolerance)
            extra-cuts nil)
      (cond
        ;; Split-host T or four-way node: two opposite collinear records form
        ;; one logical host.  Both halves must receive the same opening.
        ((and through-pair
              (not (W2L:RecordInPairP branch through-pair))
              (not (W2L:ParallelRecordsP branch (car through-pair))))
         (setq host (car through-pair)
               extra-cuts
                 (W2L:HostCutsForBranch
                   (cadr through-pair) branch junction (car endpoint))))

        ;; Unsplit host: the branch endpoint projects into its interior.
        ((not
           (W2L:EndpointHasMateP
             branch junction records snap-tolerance))
         (setq host
                (W2L:FindTJunctionHost
                  branch junction records junction-tolerance))))
      (if (and host (or (null through-pair) extra-cuts))
        (progn
          (setq result
                 (W2L:CleanOneTJunction
                   branch host junction (car endpoint)))
          (if result
            (progn
              (foreach cut (append result extra-cuts)
                (setq cuts
                       (W2L:AddCut
                         cuts (car cut) (cadr cut) (caddr cut))))
              (setq junction-count (1+ junction-count))))))))
  (list junction-count cuts))

;;; ---------------------------------------------------------------------------
;;; Deferred host-face trimming, including multiple T-junctions on one wall
;;; ---------------------------------------------------------------------------

(defun W2L:Clamp (value minimum maximum)
  (max minimum (min maximum value)))

(defun W2L:MergeIntervals (intervals tolerance / sorted merged current interval)
  (setq sorted
         (vl-sort intervals
           '(lambda (a b) (< (car a) (car b)))))
  (foreach interval sorted
    (if current
      (if (<= (car interval) (+ (cadr current) tolerance))
        (setq current
               (list (car current) (max (cadr current) (cadr interval))))
        (progn
          (setq merged (cons current merged))
          (setq current interval)))
      (setq current interval)))
  (if current (setq merged (cons current merged)))
  (reverse merged))

(defun W2L:KeepIntervals (cut-intervals total-length tolerance / keep cursor interval)
  (setq keep nil cursor 0.0)
  (foreach interval cut-intervals
    (if (> (car interval) (+ cursor tolerance))
      (setq keep (cons (list cursor (car interval)) keep)))
    (setq cursor (max cursor (cadr interval))))
  (if (> total-length (+ cursor tolerance))
    (setq keep (cons (list cursor total-length) keep)))
  (reverse keep))

(defun W2L:ApplyCutsToLine (ent cut-pairs tolerance / points start end vector unit length
                                intervals pair distance-a distance-b low high merged keep
                                interval segment-start segment-end first)
  (if (setq points (W2L:LinePoints ent))
    (progn
      (setq start  (car points)
            end    (cadr points)
            vector (W2L:V- end start)
            unit   (W2L:Unit2 vector)
            length (W2L:Length2 vector)
            intervals nil)
      (if (and unit (> length tolerance))
        (progn
          (foreach pair cut-pairs
            (setq distance-a
                   (W2L:Dot2 (W2L:V- (car pair) start) unit)
                  distance-b
                   (W2L:Dot2 (W2L:V- (cadr pair) start) unit)
                  low
                   (W2L:Clamp (min distance-a distance-b) 0.0 length)
                  high
                   (W2L:Clamp (max distance-a distance-b) 0.0 length))
            (if (> high (+ low tolerance))
              (setq intervals (cons (list low high) intervals))))
          (if intervals
            (progn
              (setq merged (W2L:MergeIntervals intervals tolerance)
                    keep   (W2L:KeepIntervals merged length tolerance))
              (if keep
                (progn
                  (setq first T)
                  (foreach interval keep
                    (setq segment-start
                           (W2L:V+ start (W2L:V* unit (car interval)))
                          segment-end
                           (W2L:V+ start (W2L:V* unit (cadr interval))))
                    (if first
                      (progn
                        (W2L:SetLineGeometry ent segment-start segment-end)
                        (setq first nil))
                      (W2L:CopyLineGeometry ent segment-start segment-end)))
                  T)
                (progn (entdel ent) T)))))))))

(defun W2L:ApplyAllCuts (cuts tolerance / count item)
  (setq count 0)
  (foreach item cuts
    (if (W2L:ApplyCutsToLine (car item) (cdr item) tolerance)
      (setq count (1+ count))))
  count)

(defun W2L:GetPositiveDistance (label previous / value)
  (initget 6)
  (setq value
         (getdist
           (strcat
             "\n" label
             (if previous
               (strcat " <" (rtos previous 2 4) ">")
               "")
             ": ")))
  (if value value previous))

(defun W2L:Run (/ *error* old-cmdecho old-osmode undo-open thickness interior-finish
                   exterior-finish exterior-side finish-left finish-right tolerance
                   snap-tolerance junction-tolerance total-finished-width
                   justification filter selection normalization normalized-sources
                   polyline-count ent source-data source-type
                   source-start source-end source-closed core-left core-right
                   outer-left outer-right created completed skipped wall-records
                   flagged-records line-records center-sources record
                   continuation-count corner-count t-result junction-count
                   cross-result crossing-count all-cuts host-cut-count cap-count
                   hatch-result hatch-count hatch-skipped)

  (setq old-cmdecho (getvar "CMDECHO")
        old-osmode  (getvar "OSMODE")
        undo-open   nil)

  (defun *error* (message)
    (if undo-open
      (progn
        (command-s "_.UNDO" "_End")
        ;; Revert the whole command group after an unexpected interruption.
        (command-s "_.UNDO" "1")
        (setq undo-open nil)))
    (setvar "CMDECHO" old-cmdecho)
    (setvar "OSMODE" old-osmode)
    (if (and message
             (/= message "Function cancelled")
             (/= message "quit / exit abort"))
      (prompt (strcat "\nWall2Line error: " message)))
    (princ))

  (if (W2L:ShowSettingsDialog)
    (setq thickness      *W2L-Thickness*
          interior-finish *W2L-InteriorFinish*
          exterior-finish *W2L-ExteriorFinish*
          justification   *W2L-Justification*
          exterior-side   *W2L-ExteriorSide*))

  (if (and thickness interior-finish exterior-finish)
    (progn
      (setq total-finished-width
              (+ thickness interior-finish exterior-finish)
            tolerance
              (max 1.0e-7
                   (* total-finished-width 1.0e-6))
            ;; Endpoint-to-endpoint corners only need a modest drafting fuzz.
            snap-tolerance
              (max tolerance (* total-finished-width 0.05))
            ;; A T branch may intentionally stop on a finished host face.  The
            ;; search envelope must therefore span the full possible offset
            ;; from the source path, including asymmetric justification.
            junction-tolerance
              (max snap-tolerance
                   (* 1.05
                      (+ thickness (max interior-finish exterior-finish)))))

      (if (= exterior-side "Left")
        (setq finish-left exterior-finish
              finish-right interior-finish)
        (setq finish-left interior-finish
              finish-right exterior-finish))

      (setq filter '((0 . "LINE,ARC,LWPOLYLINE,POLYLINE")))
      (setq selection (ssget "_I" filter))

      (if (null selection)
        (progn
          (prompt "\nSelect single-line wall paths: ")
          (setq selection (ssget filter))))

      (if selection
        (progn
          (setvar "CMDECHO" 0)
          (setvar "OSMODE" 0)
          (command-s "_.UNDO" "_Begin")
          (setq undo-open T
                completed 0
                skipped 0
                wall-records nil
                center-sources nil)

          (if (not (W2L:PrepareOutputLayers))
            (progn
              (prompt "\nWall2Line could not prepare one or more output layers.")
              (exit)))

          ;; Exploding only the selected source polylines lets every straight
          ;; terminal segment participate in corner and T-junction cleanup.
          ;; The operation is inside this command's single UNDO group.
          (if *W2L-NormalizePolylines*
            (setq normalization     (W2L:NormalizeSelection selection)
                  normalized-sources (car normalization)
                  polyline-count     (cadr normalization))
            (setq normalized-sources (W2L:SelectionEntities selection)
                  polyline-count 0))

          (foreach ent normalized-sources
            (setq source-data  (entget ent)
                  source-type  (cdr (assoc 0 source-data))
                  source-start (W2L:CurveStartPoint ent)
                  source-end   (W2L:CurveEndPoint ent)
                  source-closed (W2L:CurveClosedP ent)
                  core-left    nil
                  core-right   nil
                  outer-left   nil
                  outer-right  nil
                  created      nil)

            (cond
              ((= justification "Center")
               (setq core-left
                      (W2L:OffsetOne ent (/ thickness 2.0) "Left")
                     core-right
                      (W2L:OffsetOne ent (/ thickness 2.0) "Right")
                     outer-left
                      (W2L:OffsetOne
                        ent (+ (/ thickness 2.0) finish-left) "Left")
                     outer-right
                      (W2L:OffsetOne
                        ent (+ (/ thickness 2.0) finish-right) "Right")
                     created
                      (vl-remove nil
                        (list core-left core-right outer-left outer-right))))

              ((= justification "Left")
               (setq core-left
                      (W2L:OffsetOne ent thickness "Left")
                     core-right ent
                     outer-left
                      (W2L:OffsetOne ent (+ thickness finish-left) "Left")
                     outer-right
                      (W2L:OffsetOne ent finish-right "Right")
                     created
                      (vl-remove nil (list core-left outer-left outer-right))))

              ((= justification "Right")
               (setq core-left ent
                     core-right
                      (W2L:OffsetOne ent thickness "Right")
                     outer-left
                      (W2L:OffsetOne ent finish-left "Left")
                     outer-right
                      (W2L:OffsetOne ent (+ thickness finish-right) "Right")
                     created
                      (vl-remove nil (list core-right outer-left outer-right)))))

            (if (and source-start source-end
                     core-left core-right outer-left outer-right
                     (W2L:AssignWallLayers
                       core-left core-right outer-left outer-right exterior-side))
              (progn
                (setq wall-records
                       (cons
                         (list ent source-start source-end core-left core-right
                               outer-left outer-right source-type source-closed)
                         wall-records)
                      completed (1+ completed))
                ;; Centerlines remain temporarily so free-end topology can be
                ;; measured against every selected original path.
                (if (and (= justification "Center")
                         (not *W2L-KeepCenterlines*))
                  (setq center-sources (cons ent center-sources))))
              (progn
                (foreach ent created
                  (if (entget ent) (entdel ent)))
                (setq skipped (1+ skipped)))))

          (setq wall-records (reverse wall-records)
                flagged-records nil)

          ;; Determine free ends before any source LINE is trimmed or deleted.
          (foreach record wall-records
            (setq flagged-records
                   (cons
                     (W2L:AddFreeFlags
                       record wall-records snap-tolerance junction-tolerance)
                     flagged-records)))
          (setq wall-records (reverse flagged-records)
                line-records nil)
          (foreach record wall-records
            (if (= (W2L:RType record) "LINE")
              (setq line-records (cons record line-records))))
          (setq line-records (reverse line-records)
                continuation-count 0
                corner-count 0
                junction-count 0
                crossing-count 0
                all-cuts nil
                host-cut-count 0
                cap-count 0
                hatch-count 0
                hatch-skipped 0)

          (if (> (length line-records) 1)
            (progn
              (if *W2L-JoinContinuations*
                (setq continuation-count
                       (W2L:CleanCollinearContinuations
                         line-records snap-tolerance)))
              (if *W2L-CleanCorners*
                (setq corner-count
                       (W2L:CleanCorners line-records snap-tolerance)))
              (if *W2L-CleanTJunctions*
                (progn
                  (setq t-result
                         (W2L:CleanTJunctions
                           line-records snap-tolerance junction-tolerance)
                        junction-count (car t-result)
                        all-cuts (cadr t-result))))
              (if *W2L-CleanCrossings*
                (progn
                  (setq cross-result
                         (W2L:CleanCrossings
                           line-records all-cuts tolerance)
                        crossing-count (car cross-result)
                        all-cuts (cadr cross-result))))))

          ;; Hatches use the cleaned core boundaries before deferred crossing
          ;; cuts split any host LINE entities.
          (if *W2L-CreateHatch*
            (progn
              (setq hatch-result (W2L:CreateCoreHatches wall-records)
                    hatch-count (car hatch-result)
                    hatch-skipped (cadr hatch-result))))

          ;; Cap free ends before host lines are split at T-junction openings.
          (if *W2L-CloseEnds*
            (setq cap-count (W2L:CloseFreeEnds wall-records)))
          (if all-cuts
            (setq host-cut-count
                   (W2L:ApplyAllCuts all-cuts tolerance)))

          ;; In Center mode the original paths were only temporary topology.
          (foreach ent center-sources
            (if (entget ent) (entdel ent)))

          (command-s "_.UNDO" "_End")
          (setq undo-open nil)
          (setvar "CMDECHO" old-cmdecho)
          (setvar "OSMODE" old-osmode)

          (prompt
            (strcat
              "\nWall2Line complete: "
              (itoa completed) " converted, "
              (itoa skipped) " skipped; "
              (itoa polyline-count) " polylines normalized; "
              (itoa continuation-count) " split continuations joined; "
              (itoa corner-count) " corners and "
              (itoa junction-count) " T-junctions cleaned; "
              (itoa crossing-count) " crossings cleaned; "
              (itoa cap-count) " free ends capped; "
              (itoa hatch-count) " core hatches created"
              (if (> hatch-skipped 0)
                (strcat " (" (itoa hatch-skipped) " hatch segments skipped)")
                "")
              ".")))
        (prompt "\nNo valid wall paths were selected."))))

  (princ))

(defun c:WALL2LINE () (W2L:Run))
(defun c:W2L       () (W2L:Run))

(prompt "\nWall2Line 8.0 Panel Edition loaded. Type WALL2LINE or W2L to run.")
(princ)