;;; ---------------------------------------------------------------------------
;;; WallClean.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; CLEANING UP WHERE DOUBLE LINES CROSS
;;;
;;; PURPOSE
;;;   Two walls drawn as pairs of parallel lines cross each other, and you are
;;;   left with a little box of overlapping segments in the middle. The same
;;;   happens with ducts, pipes, kerbs and roads.
;;;
;;;   Window the mess and this clears it: a crossing becomes a clean cross, a
;;;   junction becomes a clean tee, and nothing else is touched.
;;;
;;; THE RULE IT WORKS TO
;;;   For every line in the selection, find where the OTHER selected lines cross
;;;   it. Then:
;;;
;;;     crossed twice or more  the piece between the outermost two crossings is
;;;                            removed - this is a line passing through, and the
;;;                            middle is what has to go
;;;
;;;     crossed once           the shorter end is removed - this is a line that
;;;                            runs INTO the junction and stops, so the stub
;;;                            poking out the far side is what has to go
;;;
;;;     not crossed            left alone
;;;
;;;   Those two cases are the whole of it. A cross needs the first rule on all
;;;   four lines; a tee needs the first on the wall being run into and the
;;;   second on the two lines running into it. There is no need to say which
;;;   kind of junction it is - the geometry already says.
;;;
;;; WHAT WAS FIXED
;;;   The three routines this replaces could not run. Between them they called
;;;   GETLINE, GETINTER, ECHO_OFF and ECHO_ON, none of which was in the file -
;;;   they lived in a companion called MORE.LSP that is not part of the
;;;   collection. Every one of the three failed on its first line.
;;;
;;;   They also depended on a global called OFFSET holding the wall thickness,
;;;   set by a routine in that same missing file. That routine stored it as a
;;;   STRING, via RTOS - and the cleanup then did (/ OFFSET 2.0), dividing a
;;;   string by a number. Even with the missing file present, that was an error.
;;;
;;;   Needing to be told the wall thickness at all was the deeper problem: it
;;;   meant the routines only worked on walls of one width, and had to be told
;;;   again whenever that changed. Measuring the crossings directly removes the
;;;   question.
;;;
;;;   WALLCLEAN  - tidy a crossing or a junction of double lines
;;; ---------------------------------------------------------------------------

;;; ---------------------------------------------------------------------------
;;; SUPPORT
;;; ---------------------------------------------------------------------------

;;; Where two line segments cross, or nil. The final nil asks INTERS to report
;;; only crossings that fall within BOTH segments, which is what "these two
;;; lines actually meet" means.
(defun Wall:Cross ( a b )
    (inters (car a) (cadr a) (car b) (cadr b) t)
)

;;; The endpoints of a LINE as a two-element list.
(defun Wall:Ends ( ent / d )
    (setq d (entget ent))
    (list (cdr (assoc 10 d)) (cdr (assoc 11 d)))
)

;;; Sort points by how far along the line they lie from its start.
(defun Wall:Along ( pts from )
    (vl-sort pts '(lambda ( p q ) (< (distance from p) (distance from q))))
)

;;; Replace a line with one running between two new points. Returns T if it
;;; drew something - a zero length piece is dropped rather than left as a
;;; degenerate object.
(defun Wall:Piece ( data p1 p2 )
    (if (> (distance p1 p2) 1e-8)
        (progn
            (entmake (append
                (list '(0 . "LINE") (cons 10 p1) (cons 11 p2))
                (vl-remove-if
                    '(lambda ( x ) (member (car x) '(-1 0 5 10 11 100 330)))
                    data)))
            t)
    )
)

;;; ---------------------------------------------------------------------------
;;; MAIN COMMAND
;;; ---------------------------------------------------------------------------

(defun c:WALLCLEAN ( / *error* vars vals ss i j lines ent ends hits other
                       p1 p2 first last cleaned untouched kept data n )

    (setq vars '("CMDECHO" "BLIPMODE" "HIGHLIGHT" "OSMODE")
          vals (mapcar 'getvar vars))

    (defun Wall:Restore ( )
        (mapcar 'setvar vars vals)
        (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End"))
        (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
        (princ)
    )

    (defun *error* ( msg )
        (Wall:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** WALLCLEAN error: " msg " **")))
        (princ)
    )

    (setvar "CMDECHO" 0)
    (setvar "BLIPMODE" 0)
    (setvar "HIGHLIGHT" 0)
    (setvar "OSMODE" 0)
    ;; AutoCAD 2015 and later refuse (command) inside an *error* handler unless
    ;; the routine says up front that it will use one.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")

    (princ "\nWindow the crossing - take in all the lines that meet there.")
    (setq ss (ssget '((0 . "LINE"))))

    (if (null ss)
        (princ (strcat "\nNo lines selected. This works on LINE objects - a"
                       " wall drawn as a\npolyline or a multiline has to be"
                       " exploded first."))
        (progn
            ;; Read every line up front. Doing the geometry against the ORIGINAL
            ;; endpoints matters - once pieces start being replaced, looking
            ;; them up again would measure against the new ones.
            (setq lines nil i 0)
            (while (< i (sslength ss))
                (setq ent   (ssname ss i)
                      lines (cons (list ent (Wall:Ends ent) (entget ent)) lines)
                      i     (1+ i)))
            (setq lines (reverse lines))

            (if (< (length lines) 2)
                (princ "\nTwo lines at least are needed for anything to cross.")
                (progn
                    (setq cleaned 0 untouched 0 n 0)

                    (foreach L lines
                        (setq ends (cadr L)
                              data (caddr L)
                              hits nil)

                        ;; Every crossing this line has with the others.
                        (foreach M lines
                            (if (not (eq (car L) (car M)))
                                (if (setq p1 (Wall:Cross ends (cadr M)))
                                    (setq hits (cons p1 hits)))))

                        (setq hits (Wall:Along hits (car ends)))

                        (cond
                            ;; Passing through: the middle goes, the two tails
                            ;; stay.
                            ((>= (length hits) 2)
                             (setq first (car hits)
                                   last  (car (reverse hits))
                                   kept  0)
                             (if (Wall:Piece data (car ends) first) (setq kept (1+ kept)))
                             (if (Wall:Piece data last (cadr ends)) (setq kept (1+ kept)))
                             (entdel (car L))
                             (setq cleaned (1+ cleaned) n (+ n kept)))

                            ;; Running in and stopping: the stub beyond the
                            ;; crossing goes. Which end that is depends on which
                            ;; side has less line left.
                            ((= (length hits) 1)
                             (setq p1 (car hits))
                             (if (> (distance (car ends) p1) (distance p1 (cadr ends)))
                                 (setq p2 (car ends))       ; keep the long start side
                                 (setq p2 (cadr ends)))     ; keep the long end side
                             (if (Wall:Piece data p1 p2)
                                 (progn (entdel (car L))
                                        (setq cleaned (1+ cleaned) n (1+ n)))))

                            (t (setq untouched (1+ untouched)))))

                    (princ (strcat "\n" (itoa cleaned) " line"
                                   (if (= cleaned 1) "" "s") " trimmed back into "
                                   (itoa n) " piece" (if (= n 1) "" "s") "."))
                    (if (> untouched 0)
                        (princ (strcat "\n  " (itoa untouched)
                                       " crossed nothing and "
                                       (if (= untouched 1) "was" "were")
                                       " left alone.")))
                )
            )
        )
    )

    (Wall:Restore)
    (princ)
)

(princ)