;;; ---------------------------------------------------------------------------
;;; FollowOn.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Selects a whole connected chain of curves from one picked object.
;;;
;;; Pick any line, arc, open polyline, spline or elliptical arc, and everything
;;; joined to it end to end is selected - then everything joined to THOSE, and
;;; so on outwards until the chain runs out.
;;;
;;; This is the tool for grabbing a complete pipe run, a kerb line, a services
;;; route or a site boundary that was drawn as forty separate segments by
;;; someone who had never heard of PEDIT.
;;;
;;; HOW THE CHAIN GROWS
;;; The search works outwards in waves. It starts with the endpoints of the
;;; picked object, then repeatedly sweeps the remaining candidates looking for
;;; any whose start or end point coincides with a point already in the chain.
;;; Every match found is added, ITS endpoints join the frontier, and the sweep
;;; runs again. When a full sweep adds nothing new, the chain is complete.
;;;
;;; Objects already matched are removed from the candidate pool each round, so
;;; the search gets faster as it goes rather than repeatedly re-testing the
;;; same geometry.
;;;
;;; CLOSED OBJECTS ARE EXCLUDED BY DESIGN
;;; A closed polyline, a circle or a full ellipse has no free ends, so it can
;;; neither continue a chain nor be continued from. Including them would mean a
;;; chain that touched a circle would stop dead there. The selection filter
;;; therefore rejects them outright.
;;;
;;;   FOLLOWON  - select a connected chain of curves
;;; ---------------------------------------------------------------------------

(vl-load-com)

;; ---------------------------------------------------------------------------
;; Tolerance for deciding two endpoints are the same point. Endpoints that were
;; snapped together are identical to well within this; endpoints that merely
;; look joined at normal zoom are not. Raise it if working with survey data
;; imported at low precision, but be aware that too large a value will chain
;; through junctions that are not actually connected.
;; ---------------------------------------------------------------------------
(setq FollowOn:Tolerance 1e-8)

;; ---------------------------------------------------------------------------
;; FollowOn:EscapeWildcards
;; ---------------------------------------------------------------------------
;; Escapes the characters that ssget treats as wildcards, by prefixing each
;; with a reverse quote.
;;
;; This matters because layer names are matched as patterns, not as literals.
;; A layer genuinely called "E-LIGHT[2]" contains bracket characters that ssget
;; would otherwise interpret as a character-set wildcard, so the exclusion
;; would silently fail to exclude it.
;;
;; The escaped characters are # @ . * ? ~ [ ] - and comma.
;; ---------------------------------------------------------------------------
(defun FollowOn:EscapeWildcards ( str )
    (vl-list->string
        (apply 'append
            (mapcar
                (function
                    (lambda ( c )
                        (if (member c '(35 64 46 42 63 126 91 93 45 44))
                            (list 96 c)     ; 96 is the reverse quote
                            (list c)
                        )
                    )
                )
                (vl-string->list str)
            )
        )
    )
)

;; ---------------------------------------------------------------------------
;; FollowOn:ExcludedLayers
;; ---------------------------------------------------------------------------
;; Returns filter clauses excluding every layer that is frozen, locked or off.
;;
;; Without this the chain would happily run through invisible geometry, and the
;; user would be handed a selection containing objects they cannot see and did
;; not expect - which then move when they move the rest.
;;
;; The two tests, per layer table record:
;;   negative DXF 62  - the layer is switched OFF (colour stored negated)
;;   DXF 70 bits 1|4  - bit 1 is frozen, bit 4 is locked
;; ---------------------------------------------------------------------------
(defun FollowOn:ExcludedLayers ( / rec result )
    (while (setq rec (tblnext "layer" (not rec)))
        (if (or (minusp (cdr (assoc 62 rec)))
                (< 0 (logand 5 (cdr (assoc 70 rec))))
            )
            (setq result
                (cons (cons 8 (FollowOn:EscapeWildcards (cdr (assoc 2 rec))))
                      result
                )
            )
        )
    )
    result
)

;; ---------------------------------------------------------------------------
;; FollowOn:Filter
;; ---------------------------------------------------------------------------
;; Builds the ssget filter for chainable objects.
;;
;; The type clauses, in order:
;;   LINE and ARC              - always open, always eligible
;;   LWPOLYLINE / SPLINE       - eligible unless DXF 70 bit 1 (closed) is set
;;   POLYLINE                  - eligible unless DXF 70 has any of bits 1, 8,
;;                               16, 64 (closed, 3D poly, mesh, polyface) - 89
;;                               is those four bits combined
;;   ELLIPSE                   - eligible only if it is an elliptical ARC, i.e.
;;                               its start (41) or end (42) parameter differs
;;                               from a full 0 to 2*pi sweep
;;
;; The trailing space clause confines the search to the space the user is
;; actually working in - the current layout when in paper space, model space
;; otherwise - so a chain cannot leap between a viewport and the sheet.
;; ---------------------------------------------------------------------------
(defun FollowOn:Filter ( / excluded )
    (setq excluded (FollowOn:ExcludedLayers))
    (append
        (list
           '(-4 . "<OR")
               '(0 . "LINE,ARC")
               '(-4 . "<AND")
                   '(0 . "LWPOLYLINE,SPLINE")
                   '(-4 . "<NOT") '(-4 . "&=") '(70 . 1) '(-4 . "NOT>")
               '(-4 . "AND>")
               '(-4 . "<AND")
                   '(0 . "POLYLINE")
                   '(-4 . "<NOT") '(-4 . "&") '(70 . 89) '(-4 . "NOT>")
               '(-4 . "AND>")
               '(-4 . "<AND")
                   '(0 . "ELLIPSE")
                   '(-4 . "<OR")
                       '(-4 . "<>") '(41 . 0.0)
                       '(-4 . "<>")  (cons 42 (+ pi pi))
                   '(-4 . "OR>")
               '(-4 . "AND>")
           '(-4 . "OR>")
            (if (= 1 (getvar 'cvport))
                (cons 410 (getvar 'ctab))
               '(410 . "Model")
            )
        )
        ;; Wrap the excluded layers as NOT ( OR layer1 layer2 ... )
        (if excluded
            (append '((-4 . "<NOT") (-4 . "<OR"))
                    excluded
                   '((-4 . "OR>") (-4 . "NOT>"))
            )
        )
    )
)

;; ---------------------------------------------------------------------------
;; c:FOLLOWON  -  main routine
;; ---------------------------------------------------------------------------
(defun c:FOLLOWON ( / *error* filter pool pick chain ends candidates
                      leftover matched idx ent item )

    ;; This routine only selects - nothing is created, modified or deleted - so
    ;; no system variables are altered and no undo group is opened.
    (defun *error* ( msg )
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** FOLLOWON error: " msg " **"))
        )
        (princ)
    )

    (setq filter (FollowOn:Filter))

    (cond
        ;; Gather every chainable object in the drawing up front - this is the
        ;; pool the chain will be grown from.
        (   (not (setq pool (ssget "_X" filter)))
            (princ "\nNo chainable objects found in this space.")
        )

        ;; "_+.:E:S" is single-pick, single-object, with the same filter - so
        ;; the user simply cannot start a chain from an ineligible object.
        (   (not (setq pick (ssget "_+.:E:S" filter)))
            (princ "\n*Cancelled* - nothing picked.")
        )

        (   t
            (setq chain (ssadd)
                  ent   (ssname pick 0)
                  ;; The frontier: endpoints the chain can currently grow from.
                  ends  (list (vlax-curve-getstartpoint ent)
                              (vlax-curve-getendpoint   ent)
                        )
            )

            ;; Reduce the pool to (startPoint endPoint entityName) triples once,
            ;; rather than re-querying the curve geometry on every sweep.
            (repeat (setq idx (sslength pool))
                (setq ent (ssname pool (setq idx (1- idx)))
                      candidates
                          (cons (list (vlax-curve-getstartpoint ent)
                                      (vlax-curve-getendpoint   ent)
                                      ent
                                )
                                candidates
                          )
                )
            )

            ;; Sweep outwards until a full pass adds nothing new.
            (while
                (progn
                    (setq leftover nil
                          matched  nil
                    )
                    (foreach item candidates
                        (if (vl-some
                                (function
                                    (lambda ( p )
                                        (or (equal (car  item) p FollowOn:Tolerance)
                                            (equal (cadr item) p FollowOn:Tolerance)
                                        )
                                    )
                                )
                                ends
                            )
                            ;; Joined: add it, and push its two endpoints onto
                            ;; the frontier so the next sweep can grow from them.
                            (setq chain   (ssadd (caddr item) chain)
                                  ends    (vl-list* (car item) (cadr item) ends)
                                  matched t
                            )
                            ;; Not joined this round - keep it for the next.
                            (setq leftover (cons item leftover))
                        )
                    )
                    (setq candidates leftover)
                    matched
                )
            )

            (sssetfirst nil chain)
            (princ (strcat "\n" (itoa (sslength chain))
                           " object" (if (= 1 (sslength chain)) "" "s")
                           " selected in the chain."
                   )
            )
        )
    )

    (princ)
)

(princ)