;;; ---------------------------------------------------------------------------
;;; TextRail.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; DYNAMIC TEXT ALIGNMENT
;;;
;;; Select a scattered group of Text or MText objects, then drag: the whole
;;; group snaps into line and follows the cursor live. Release, and it is
;;; done. There is no dialog, no repeated MOVE, and no guessing -- you see
;;; the final arrangement before you commit to it.
;;;
;;; TextRail has two families of alignment.
;;;
;;;   STRAIGHT-LINE MODES -- the text lines up on an invisible rail that you
;;;   drag out with the cursor:
;;;
;;;     HORIZONTAL  each item slides sideways onto the rail, keeping its own
;;;                 height. Use it to left-align a ragged column of labels.
;;;     VERTICAL    each item slides up or down onto the rail, keeping its
;;;                 own horizontal position. Use it to level a ragged row.
;;;     STRETCH     the items are spread evenly between the anchor point and
;;;                 the cursor, so the whole group stretches or compresses
;;;                 like a concertina.
;;;
;;;   CURVE MODE -- the text is strung out along any curved object you pick:
;;;   a polyline, arc, circle, spline, ellipse, line or xline. Spacing along
;;;   the curve, offset away from the curve, and rotation to the curve
;;;   tangent are all adjustable live.
;;;
;;; ---------------------------------------------------------------------------
;;; HOW IT WORKS
;;;
;;; The whole command runs inside a grread loop. grread reports every mouse
;;; move and every keystroke without ending the command, which is what makes
;;; live dragging possible.
;;;
;;; On each mouse move the program:
;;;   1. Reads the new cursor position.
;;;   2. Computes where every selected text object should now sit.
;;;   3. Writes those positions straight to the objects through ActiveX.
;;;   4. Draws a temporary rubber-band vector so the rail is visible.
;;;
;;; Because step 3 modifies the real objects rather than drawing a preview,
;;; what you see during the drag IS the result. The consequence is that
;;; cancelling has to actively undo the changes -- which is exactly what the
;;; error handler does, restoring every object's saved position and rotation
;;; before it exits.
;;;
;;; ---------------------------------------------------------------------------
;;; JUSTIFICATION-AWARE POSITIONING
;;;
;;; Text objects have two possible position properties and using the wrong
;;; one produces text that jumps unpredictably:
;;;
;;;   InsertionPoint       meaningful only for left-justified Text
;;;   TextAlignmentPoint   meaningful for every other justification
;;;
;;; MText always uses InsertionPoint, but interprets it relative to its
;;; AttachmentPoint. TextRail therefore inspects each object once and
;;; remembers which property to drive, so a mixed selection of centred,
;;; right-aligned and middle-justified text all behaves correctly.
;;;
;;; ---------------------------------------------------------------------------
;;; LIVE CONTROLS
;;;
;;; While dragging in straight-line mode:
;;;   TAB      cycle Horizontal / Vertical / Stretch
;;;   S        set a fixed spacing between items instead of dragging
;;;   R        type an exact rotation angle, or drag to set it
;;;   J        change the justification of every selected item
;;;   O        switch to curve mode and pick the object to follow
;;;   C        cycle the colour of the rubber-band guide line
;;;   F8       toggle ortho, constraining the rail to horizontal or vertical
;;;   SHIFT    align text rotation to the rail (needs Express Tools)
;;;   click    accept
;;;   Esc      cancel and put everything back
;;;
;;; While dragging in curve mode:
;;;   S        set the spacing measured along the curve
;;;   O        set the offset away from the curve
;;;   V        reverse the order of the items along the curve
;;;   R        set the text rotation
;;;   C        cycle guide colour
;;;   E        return to straight-line mode
;;;   SHIFT    rotate each item to the curve tangent at its own position
;;;
;;; ---------------------------------------------------------------------------
;;; NOTES
;;;
;;; SHIFT detection uses the Express Tools function acet-sys-shift-down. If
;;; Express Tools is not installed the program still runs; only the
;;; shift-to-rotate shortcut is unavailable, and the R key covers the same
;;; ground.
;;;
;;; ORTHOMODE is deliberately NOT restored on exit. Pressing F8 during the
;;; command is a real user decision and behaves exactly as it does in any
;;; native AutoCAD command -- the new setting persists afterwards.
;;;
;;; ---------------------------------------------------------------------------
;;;   TEXTRAIL - align selected text dynamically
;;; ---------------------------------------------------------------------------

(vl-load-com)

;;; ---------------------------------------------------------------------------
;;; Persistent preferences.
;;;
;;; These four remember your last settings between runs, so the command comes
;;; back the way you left it. They must be global to survive from one call to
;;; the next; each is namespaced so nothing else can collide with them.
;;;
;;;   *TextRail:Mode*     0 horizontal, 1 vertical, 2 stretch
;;;   *TextRail:Spacing*  fixed spacing between items
;;;   *TextRail:Rot*      text rotation, in degrees
;;;   *TextRail:Offset*   offset away from the curve, in curve mode
;;;   *TextRail:Just*     justification index, 1 = top-left through 9 = bottom-right
;;; ---------------------------------------------------------------------------

(or *TextRail:Mode*    (setq *TextRail:Mode*      0))
(or *TextRail:Spacing* (setq *TextRail:Spacing* 10.0))
(or *TextRail:Rot*     (setq *TextRail:Rot*     0.0))
(or *TextRail:Offset*  (setq *TextRail:Offset*  0.0))
(or *TextRail:Just*    (setq *TextRail:Just*      1))

;;; ---------------------------------------------------------------------------
;;; TextRail:Doc
;;;
;;; Returns the active document object.
;;;
;;; Fetching the document through the ActiveX chain is comparatively slow and
;;; the answer never changes within a drawing session, so on its first call
;;; this function redefines itself to return the cached object directly.
;;; ---------------------------------------------------------------------------

(defun TextRail:Doc nil
    (eval (list 'defun 'TextRail:Doc 'nil
                (vla-get-activedocument (vlax-get-acad-object))
          )
    )
    (TextRail:Doc)
)

;;; ---------------------------------------------------------------------------
;;; TEXTRAIL
;;; ---------------------------------------------------------------------------

(defun c:TextRail

    ( /

      ;; ---- nested helper functions ----
      *error* TextRail:Anchors TextRail:Prompt TextRail:Restore
      TextRail:SetRotation TextRail:SetOffset TextRail:SetSpacing
      TextRail:Str2Num TextRail:Sort

      ;; ---- local variables ----
      ang anchors basang basdis baspt bpt cang cmode code col cpt curvemsg
      data der dis doc dspc ent expresstools foo bar fooc gr idx iptn jlst
      jdx k modes curvemodes objlst perp plst prop pt pto saved ss tanfix
      tmplst vals vars
    )

    ;;; -----------------------------------------------------------------------
    ;;; State to save and restore.
    ;;;
    ;;; CMDECHO is silenced so the temporary prompts do not fill the command
    ;;; history. ORTHOMODE is intentionally absent -- see the header.
    ;;; -----------------------------------------------------------------------

    (setq vars '("CMDECHO")
          vals (mapcar 'getvar vars)
          doc  (TextRail:Doc)
    )

    ;;; -----------------------------------------------------------------------
    ;;; TextRail:Restore
    ;;;
    ;;; Puts the drawing environment back exactly as it was found: system
    ;;; variables, temporary graphics, and any undo group still open.
    ;;;
    ;;; The undo loop tests bit 8 of UNDOCTL, which is set while an undo group
    ;;; is open. Looping rather than closing once guarantees that a nested
    ;;; group left open by an interrupted operation is also closed, so the
    ;;; user's next undo cannot swallow unrelated work.
    ;;; -----------------------------------------------------------------------

    (defun TextRail:Restore ( )
        (redraw)
        (mapcar 'setvar vars vals)
        (while (= 8 (logand 8 (getvar 'undoctl)))
            (vla-endundomark doc)
        )
        (princ)
    )

    ;;; -----------------------------------------------------------------------
    ;;; *error*
    ;;;
    ;;; Because the drag preview works by moving the real objects, a cancel
    ;;; must actively put every object back. The saved list holds each
    ;;; object's original rotation and original position property value; both
    ;;; are written back before anything else happens.
    ;;;
    ;;; Each restore is wrapped in a catch: an object may have been erased or
    ;;; its layer locked while the command was running, and one failure must
    ;;; not prevent the remaining objects from being restored.
    ;;; -----------------------------------------------------------------------

    (defun *error* ( msg )
        (foreach item saved
            (vl-catch-all-apply
               '(lambda ( )
                    (vlax-put (car item) (cadr item) (cadddr item))   ;; position
                    (vlax-put (car item) 'rotation   (caddr  item))   ;; rotation
                )
            )
        )
        (TextRail:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** TEXTRAIL error: " msg " **"))
        )
        (princ)
    )

    ;;; -----------------------------------------------------------------------
    ;;; TextRail:Anchors
    ;;;
    ;;; For every object in the supplied list, works out which property
    ;;; actually controls its position and records the current state.
    ;;;
    ;;; Returns a list of entries, one per object:
    ;;;     (object property-symbol original-rotation original-point)
    ;;;
    ;;; The property choice is the crux of the whole routine:
    ;;;   * Left-justified Text is positioned by InsertionPoint; its
    ;;;     TextAlignmentPoint is ignored by AutoCAD and reads as (0 0 0).
    ;;;   * Every other Text justification is positioned by
    ;;;     TextAlignmentPoint; writing InsertionPoint would move nothing.
    ;;;   * MText is always positioned by InsertionPoint.
    ;;;
    ;;; Recording rotation and position at the same time gives the error
    ;;; handler everything it needs to undo a cancelled drag.
    ;;;
    ;;;   objects - list of VLA text objects
    ;;; -----------------------------------------------------------------------

    (defun TextRail:Anchors ( objects )
        (mapcar
           '(lambda ( obj / prop )
                (setq prop
                    (if (= "AcDbText" (vla-get-objectname obj))
                        (if (= acalignmentleft (vla-get-alignment obj))
                            'insertionpoint
                            'textalignmentpoint
                        )
                        'insertionpoint
                    )
                )
                (list obj prop (vlax-get obj 'rotation) (vlax-get obj prop))
            )
            objects
        )
    )

    ;;; -----------------------------------------------------------------------
    ;;; TextRail:Sort
    ;;;
    ;;; Orders the anchor list along the axis the current mode works on, so
    ;;; that items are laid out in the sequence they visually appear rather
    ;;; than the arbitrary order the selection set returned them in.
    ;;;
    ;;;   lst  - anchor list from TextRail:Anchors
    ;;;   fn   - 'car to sort by X, 'cadr to sort by Y
    ;;;   test - '< for ascending, '> for descending
    ;;;
    ;;; fn and test are held as quoted symbols and evaluated at the point of
    ;;; use, which is what lets one sort routine serve every mode.
    ;;; -----------------------------------------------------------------------

    (defun TextRail:Sort ( lst fn test )
        (vl-sort lst
           '(lambda ( a b )
                (   (eval test)
                    ((eval fn) (vlax-get (car a) (cadr a)))
                    ((eval fn) (vlax-get (car b) (cadr b)))
                )
            )
        )
    )

    ;;; -----------------------------------------------------------------------
    ;;; TextRail:Str2Num
    ;;;
    ;;; Converts typed text to a number, trying every AutoCAD distance format
    ;;; in turn: decimal, engineering, architectural, fractional and
    ;;; scientific. Returns nil if the string is not a valid distance in any
    ;;; of them.
    ;;;
    ;;; This is needed because the grread loop collects keystrokes itself and
    ;;; so cannot use getdist, which would end the drag.
    ;;; -----------------------------------------------------------------------

    (defun TextRail:Str2Num ( str )
        (cond
            ((distof str 5))   ;; decimal
            ((distof str 2))   ;; engineering
            ((distof str 1))   ;; scientific
            ((distof str 4))   ;; architectural
            ((distof str 3))   ;; fractional
        )
    )

    ;;; -----------------------------------------------------------------------
    ;;; TextRail:Prompt
    ;;;
    ;;; Reprints the straight-line-mode key list. It is called again after
    ;;; every sub-operation that writes to the command line, so the available
    ;;; keys and the current mode are always visible.
    ;;; -----------------------------------------------------------------------

    (defun TextRail:Prompt ( )
        (princ
            (strcat
                "\n[TAB] change mode, [S]pace text, [SHIFT] align rotation"
                "\n[R]otation, [O]bject, [J]ustification, [C]olour"
                "\nCurrent mode: " (nth *TextRail:Mode* modes)
            )
        )
    )

    ;;; -----------------------------------------------------------------------
    ;;; TextRail:SetRotation
    ;;;
    ;;; Sub-loop entered with the R key. The user may either drag to set the
    ;;; rotation visually, or type an exact angle, or type "Reset" to return
    ;;; every item to the rotation it had when the command started.
    ;;;
    ;;; Returns with the rotation applied to every object.
    ;;; -----------------------------------------------------------------------

    (defun TextRail:SetRotation ( / buf msg grr codr datr rpt rang )
        (setq buf "")
        (princ (setq msg (strcat "\nSpecify text rotation [Reset] <"
                                 (vl-princ-to-string *TextRail:Rot*) "> : ")))
        (while
            (progn
                (setq grr  (grread t 15 0)
                      codr (car  grr)
                      datr (cadr grr)
                )
                (redraw)
                (cond
                    ;;  --- mouse moved: rotate live to follow the cursor ---
                    (   (and (= 5 codr) (listp datr))
                        ;; Rotate about the first object's own anchor point so
                        ;; the pivot is something the user can see.
                        (setq rpt (last (car (TextRail:Anchors (list (car objlst))))))
                        ;; Honour ortho by snapping the drag to the nearer axis.
                        (if (not (zerop (getvar 'orthomode)))
                            (if (< (abs (- (car datr) (car rpt)))
                                   (abs (- (cadr datr) (cadr rpt))))
                                (setq datr (list (car rpt) (cadr datr) (caddr datr)))
                                (setq datr (list (car datr) (cadr rpt) (caddr datr)))
                            )
                        )
                        (setq rang (angle rpt datr))
                        (foreach obj objlst (vla-put-rotation obj rang))
                        (grdraw rpt datr 40 1)
                        t
                    )
                    ;;  --- printable character typed: add to the input buffer ---
                    (   (and (= 2 codr) (< 46 datr 123))
                        (princ (chr datr))
                        (setq buf (strcat buf (chr datr)))
                    )
                    ;;  --- backspace: erase one character, on screen and in the buffer ---
                    (   (and (= 2 codr) (= 8 datr) (< 0 (strlen buf)))
                        (princ (vl-list->string '(8 32 8)))   ;; back, space, back
                        (setq buf (substr buf 1 (1- (strlen buf))))
                    )
                    ;;  --- F8: toggle ortho ---
                    (   (and (= 2 codr) (= 15 datr))
                        (setvar 'orthomode (- 1 (getvar 'orthomode)))
                    )
                    ;;  --- Enter, Space or right-click: accept what was typed ---
                    (   (or (and (= 2 codr) (vl-position datr '(32 13)))
                            (= 25 codr)
                        )
                        (cond
                            (   (< 0 (strlen buf))
                                (cond
                                    ;;  "Reset" means: put the original rotations back.
                                    (   (wcmatch (strcase buf) "R,RESET")
                                        (setq rang nil)
                                    )
                                    ;;  A valid angle: remember it in degrees and finish.
                                    (   (setq rang (angtof buf 0))
                                        (setq *TextRail:Rot* (* 180. (/ rang pi)))
                                        nil
                                    )
                                    ;;  Anything else: complain and keep looping.
                                    (   (princ "\nInvalid angle entered.")
                                        (setq buf "")
                                        (princ msg)
                                    )
                                )
                            )
                            ;;  Nothing typed: accept the stored default.
                            (   t (setq rang (* pi (/ *TextRail:Rot* 180.))) nil)
                        )
                    )
                    ;;  --- click: accept the dragged angle ---
                    (   (and (= 3 codr) (listp datr))
                        (setq *TextRail:Rot* (* 180. (/ rang pi)))
                        nil
                    )
                    (   t (princ "\nInvalid input.") (princ msg))
                )
            )
        )
        ;; Apply the chosen angle, or roll every rotation back if Reset was used.
        (if rang
            (foreach obj objlst (vla-put-rotation obj rang))
            (foreach item saved (vla-put-rotation (car item) (caddr item)))
        )
    )

    ;;; -----------------------------------------------------------------------
    ;;; TextRail:SetOffset
    ;;;
    ;;; Curve mode sub-loop entered with the O key. Sets how far the text sits
    ;;; away from the curve, perpendicular to it.
    ;;;
    ;;; The visual feedback is a 50-segment ghost of the offset path, drawn
    ;;; with grvecs. Each ghost point is the curve point pushed out along the
    ;;; local perpendicular, so on a curved object the ghost curves too and
    ;;; the user can see exactly where the text will land.
    ;;; -----------------------------------------------------------------------

    (defun TextRail:SetOffset
        ( / basedis buf grlst grr codr datr cpt ang inc pto tmpoff tmppt vecs n )

        (setq buf "")
        (princ (strcat "\nSpecify text offset [Exit] <"
                       (vl-princ-to-string *TextRail:Offset*) "> : "))

        ;; Distance along the curve of the first item, and the step between
        ;; the 50 ghost points that will span first item to last.
        (setq basedis
            (vlax-curve-getdistatpoint ent
                (vlax-curve-getclosestpointto ent
                    (vlax-get (caar plst) (cadar plst))
                )
            )
        )
        (setq inc
            (/ (- (vlax-curve-getdistatpoint ent
                      (vlax-curve-getclosestpointto ent
                          (vlax-get (car (last plst)) (cadr (last plst)))
                      )
                  )
                  basedis
               )
               50.
            )
        )

        (while
            (progn
                (setq grr  (grread t 15 0)
                      codr (car  grr)
                      datr (cadr grr)
                )
                (redraw)
                (cond
                    (   (and (= 5 codr) (listp datr))

                        ;; Closest point on the curve to the cursor, and the
                        ;; direction from it to the cursor. That direction is
                        ;; the offset direction; that distance is the offset.
                        (setq cpt (vlax-curve-getclosestpointto ent datr)
                              ang (angle cpt datr)
                        )
                        (grdraw cpt datr 40 1)

                        ;; tanfix is the angle between the curve tangent at
                        ;; the cursor and the offset direction. Subtracting it
                        ;; from the tangent at any OTHER point on the curve
                        ;; reproduces the same relative offset there, which is
                        ;; what keeps the offset consistent around a bend.
                        (setq tanfix
                            (- (angle '(0 0 0)
                                   (vlax-curve-getfirstderiv ent
                                       (vlax-curve-getparamatpoint ent cpt)
                                   )
                               )
                               ang
                            )
                        )

                        ;; Ghost the offset path.
                        (setq grlst nil n -1)
                        (repeat 50
                            (setq tmppt (vlax-curve-getpointatdist ent
                                            (+ basedis (* (setq n (1+ n)) inc))
                                        )
                            )
                            (setq grlst
                                (cons
                                    (polar tmppt
                                        ;; Straight objects have a constant
                                        ;; tangent, so the cursor direction is
                                        ;; used unchanged; curves need the
                                        ;; local tangent minus tanfix.
                                        (if (vl-position (cdr (assoc 0 (entget ent)))
                                                        '("XLINE" "LINE" "RAY"))
                                            ang
                                            (- (angle '(0 0 0)
                                                   (vlax-curve-getfirstderiv ent
                                                       (vlax-curve-getparamatpoint ent tmppt)
                                                   )
                                               )
                                               tanfix
                                            )
                                        )
                                        (distance cpt datr)
                                    )
                                    grlst
                                )
                            )
                        )
                        ;; -91 is the grvecs colour code for a highlighted vector.
                        (grvecs (cons -91 grlst))

                        ;; Move every item out to the new offset.
                        (foreach item plst
                            (setq pto (vlax-curve-getclosestpointto ent
                                          (vlax-get (car item) (cadr item))
                                      )
                            )
                            (vlax-put (car item) (cadr item)
                                (polar pto
                                    (if (vl-position (cdr (assoc 0 (entget ent)))
                                                    '("XLINE" "LINE" "RAY"))
                                        ang
                                        (- (angle '(0 0 0)
                                               (vlax-curve-getfirstderiv ent
                                                   (vlax-curve-getparamatpoint ent pto)
                                               )
                                           )
                                           tanfix
                                        )
                                    )
                                    (setq tmpoff (distance cpt datr))
                                )
                            )
                        )
                        t
                    )
                    (   (and (= 2 codr) (< 46 datr 123))
                        (princ (chr datr))
                        (setq buf (strcat buf (chr datr)))
                    )
                    (   (and (= 2 codr) (= 8 datr) (< 0 (strlen buf)))
                        (princ (vl-list->string '(8 32 8)))
                        (setq buf (substr buf 1 (1- (strlen buf))))
                    )
                    (   (and (= 2 codr) (= 15 datr))
                        (setvar 'orthomode (- 1 (getvar 'orthomode)))
                    )
                    (   (or (and (= 2 codr) (vl-position datr '(32 13)))
                            (= 25 codr)
                        )
                        (cond
                            (   (< 0 (strlen buf))
                                (cond
                                    (   (wcmatch (strcase buf) "E,EXIT") nil)
                                    (   (setq tmpoff (TextRail:Str2Num buf))
                                        (setq *TextRail:Offset* tmpoff)
                                        nil
                                    )
                                    (   (princ "\nInvalid distance entered.")
                                        (setq buf "")
                                        t
                                    )
                                )
                            )
                            (   t nil)
                        )
                    )
                    (   (and (= 3 codr) (listp datr))
                        (if tmpoff (setq *TextRail:Offset* tmpoff))
                        nil
                    )
                    (   t (princ "\nInvalid input.") nil)
                )
            )
        )
        (princ)
    )

    ;;; -----------------------------------------------------------------------
    ;;; TextRail:SetSpacing
    ;;;
    ;;; Curve mode sub-loop entered with the S key. Sets the distance between
    ;;; consecutive items measured ALONG the curve, so text stays evenly
    ;;; spaced even where the curve bends sharply.
    ;;;
    ;;; Dragging works like a stretch: the first item stays put, the cursor
    ;;; position sets where the last item lands, and the spacing follows from
    ;;; the number of items in between.
    ;;; -----------------------------------------------------------------------

    (defun TextRail:SetSpacing
        ( / basedis basept buf grlst grr codr datr cpt ang inc n pto tmpspc tmppt )

        (setq buf "")
        (princ (strcat "\nSpecify text spacing [Exit] <"
                       (vl-princ-to-string dspc) "> : "))

        ;; The first item is the fixed end of the concertina.
        (setq basedis
            (vlax-curve-getdistatpoint ent
                (setq basept
                    (vlax-curve-getclosestpointto ent
                        (vlax-get (caar plst) (cadar plst))
                    )
                )
            )
        )

        (while
            (progn
                (setq grr  (grread t 15 0)
                      codr (car  grr)
                      datr (cadr grr)
                )
                (redraw)
                (cond
                    (   (and (= 5 codr) (listp datr))

                        (setq cpt (vlax-curve-getclosestpointto ent datr)
                              ang (angle cpt datr)
                              k   0
                        )
                        ;; Spacing = the along-curve span from first item to
                        ;; cursor, divided by the number of gaps. fooc is 1+
                        ;; normally and 1- when the order has been reversed,
                        ;; which flips the direction items are laid out in.
                        (setq tmpspc
                            (/ (* ((eval fooc) 0.)
                                  (- (vlax-curve-getdistatpoint ent cpt) basedis)
                               )
                               (float (max 1 (1- (length plst))))
                            )
                        )
                        (grdraw cpt datr 40 1)

                        (setq tanfix
                            (- (angle '(0 0 0)
                                   (vlax-curve-getfirstderiv ent
                                       (vlax-curve-getparamatpoint ent cpt)
                                   )
                               )
                               ang
                            )
                        )

                        ;; Keep the first item pinned at its offset position.
                        (vlax-put (caar plst) (cadar plst)
                            (polar basept
                                (if (vl-position (cdr (assoc 0 (entget ent)))
                                                '("XLINE" "LINE" "RAY"))
                                    ang
                                    (- (angle '(0 0 0)
                                           (vlax-curve-getfirstderiv ent
                                               (vlax-curve-getparamatpoint ent basept)
                                           )
                                       )
                                       tanfix
                                    )
                                )
                                *TextRail:Offset*
                            )
                        )

                        ;; Ghost the span being stretched over.
                        (setq grlst nil
                              n     -1
                              inc   (/ (- (vlax-curve-getdistatpoint ent cpt) basedis) 50.)
                        )
                        (repeat 50
                            (setq tmppt (vlax-curve-getpointatdist ent
                                            (+ basedis (* (setq n (1+ n)) inc))
                                        )
                            )
                            (setq grlst
                                (cons
                                    (polar tmppt
                                        (if (vl-position (cdr (assoc 0 (entget ent)))
                                                        '("XLINE" "LINE" "RAY"))
                                            ang
                                            (- (angle '(0 0 0)
                                                   (vlax-curve-getfirstderiv ent
                                                       (vlax-curve-getparamatpoint ent tmppt)
                                                   )
                                               )
                                               tanfix
                                            )
                                        )
                                        (distance cpt datr)
                                    )
                                    grlst
                                )
                            )
                        )
                        (grvecs (cons -91 grlst))

                        ;; Space the remaining items out along the curve.
                        (foreach item (cdr plst)
                            (if (setq pto (vlax-curve-getpointatdist ent
                                              (+ basedis (* (setq k ((eval fooc) k)) tmpspc))
                                          )
                                )
                                (vlax-put (car item) (cadr item)
                                    (polar pto
                                        (if (vl-position (cdr (assoc 0 (entget ent)))
                                                        '("XLINE" "LINE" "RAY"))
                                            ang
                                            (- (angle '(0 0 0)
                                                   (vlax-curve-getfirstderiv ent
                                                       (vlax-curve-getparamatpoint ent pto)
                                                   )
                                               )
                                               tanfix
                                            )
                                        )
                                        *TextRail:Offset*
                                    )
                                )
                            )
                        )
                        t
                    )
                    (   (and (= 2 codr) (< 46 datr 123))
                        (princ (chr datr))
                        (setq buf (strcat buf (chr datr)))
                    )
                    (   (and (= 2 codr) (= 8 datr) (< 0 (strlen buf)))
                        (princ (vl-list->string '(8 32 8)))
                        (setq buf (substr buf 1 (1- (strlen buf))))
                    )
                    (   (and (= 2 codr) (= 15 datr))
                        (setvar 'orthomode (- 1 (getvar 'orthomode)))
                    )
                    (   (or (and (= 2 codr) (vl-position datr '(32 13)))
                            (= 25 codr)
                        )
                        (cond
                            (   (< 0 (strlen buf))
                                (cond
                                    (   (wcmatch (strcase buf) "E,EXIT") nil)
                                    (   (setq tmpspc (TextRail:Str2Num buf))
                                        (setq dspc tmpspc)
                                        nil
                                    )
                                    (   (princ "\nInvalid distance entered.")
                                        (setq buf "")
                                        t
                                    )
                                )
                            )
                            (   t nil)
                        )
                    )
                    (   (and (= 3 codr) (listp datr))
                        (if tmpspc (setq dspc tmpspc))
                        nil
                    )
                    (   t (princ "\nInvalid input.") nil)
                )
            )
        )
        (princ)
    )

    ;;; =======================================================================
    ;;;                       M A I N   R O U T I N E
    ;;; =======================================================================

    (setvar 'cmdecho 0)
    (vla-startundomark doc)

    ;; ---- Express Tools shift detection ------------------------------------
    ;; acet-sys-shift-down reports whether the SHIFT key is currently held.
    ;; It lives in acetutil.arx, which may not be loaded even when Express
    ;; Tools is installed, so load it on demand and then test whether the
    ;; function actually answers. Everything else works without it.

    (if (and (not acet-sys-shift-down) (findfile "acetutil.arx"))
        (vl-catch-all-apply 'arxload (list (findfile "acetutil.arx")))
    )
    (setq expresstools
        (not (vl-catch-all-error-p
                 (vl-catch-all-apply 'acet-sys-shift-down '())
             )
        )
    )

    (setq modes      '("HORIZONTAL" "VERTICAL" "STRETCH")
          curvemodes '("CURVE MOVE" "CURVE STRETCH" "CURVE OFFSET")
          cmode      0
          col        3
    )

    ;; ---- select the text ---------------------------------------------------
    ;; "_:L" excludes objects on locked layers, which could not be moved
    ;; anyway. "*TEXT" catches both TEXT and MTEXT.

    (princ "\nSelect text to align...")
    (setq ss (ssget "_:L" '((0 . "*TEXT"))))

    (cond
        (   (null ss)
            (princ "\nNothing selected.")
        )

        ;;  A single object has nothing to align to and would divide by zero
        ;;  when the spacing is computed, so it is rejected explicitly rather
        ;;  than being allowed to fail later.
        (   (= 1 (sslength ss))
            (princ "\nSelect two or more text objects to align.")
        )

        (   t
            ;; ---- pick the anchor point ------------------------------------
            ;; The user may click a point, or press T and select an existing
            ;; text object whose own anchor point is then used. That second
            ;; route is how you align a group precisely to text you already
            ;; have, with no snapping required.

            (while
                (progn
                    (initget "Text")
                    (or (vl-consp pt)
                        (setq pt (getpoint "\nSpecify alignment point or [T]ext object: "))
                    )
                    (cond
                        (   (vl-consp pt) nil)
                        (   (= "Text" pt)
                            (while
                                (progn
                                    (initget "Point")
                                    (setq ent (entsel "\nSelect text object or [P]oint: "))
                                    (cond
                                        (   (vl-consp ent)
                                            (if (wcmatch (cdr (assoc 0 (entget (car ent)))) "*TEXT")
                                                (not
                                                    (setq pt
                                                        (last (car (TextRail:Anchors
                                                                       (list (vlax-ename->vla-object (car ent)))
                                                                   )
                                                              )
                                                        )
                                                    )
                                                )
                                                (princ "\nObject is not text.")
                                            )
                                        )
                                        (   (= "Point" ent) nil)
                                        (   t (princ "\nNothing selected."))
                                    )
                                )
                            )
                            t
                        )
                    )
                )
            )

            (if (not (vl-consp pt))
                (princ "\nNo alignment point specified.")
                (progn
                    ;; ---- capture the starting state -----------------------
                    (setq idx -1)
                    (repeat (sslength ss)
                        (setq objlst
                            (cons (vlax-ename->vla-object (ssname ss (setq idx (1+ idx))))
                                  objlst
                            )
                        )
                    )
                    (setq saved (TextRail:Anchors objlst))

                    ;; Sort into visual order for the starting mode: vertical
                    ;; mode works left to right by X, everything else works
                    ;; top to bottom by Y.
                    (if (= 1 *TextRail:Mode*)
                        (setq foo 'car  bar '<)
                        (setq foo 'cadr bar '>)
                    )
                    (setq objlst (mapcar 'car (TextRail:Sort saved foo bar)))

                    (TextRail:Prompt)

                    ;; ---- the main drag loop -------------------------------
                    (while
                        (progn
                            (setq gr   (grread t 15 0)
                                  code (car  gr)
                                  data (cadr gr)
                            )
                            (redraw)
                            (cond

                                ;;  ---- mouse moved: reposition everything ----
                                (   (and (= 5 code) (listp data))

                                    ;; In stretch mode the rail starts at the
                                    ;; first item; in the other modes it starts
                                    ;; at the point the user picked.
                                    (setq bpt
                                        (if (= 2 *TextRail:Mode*)
                                            (last (car (TextRail:Anchors (list (car objlst)))))
                                            pt
                                        )
                                    )

                                    ;; Ortho: collapse the drag onto whichever
                                    ;; axis it is closer to.
                                    (if (not (zerop (getvar 'orthomode)))
                                        (if (< (abs (- (car data) (car bpt)))
                                               (abs (- (cadr data) (cadr bpt))))
                                            (setq data (list (car bpt) (cadr data) (caddr data)))
                                            (setq data (list (car data) (cadr bpt) (caddr data)))
                                        )
                                    )

                                    ;; perp is the direction each item travels
                                    ;; to reach the rail: horizontally in
                                    ;; horizontal mode, vertically in vertical
                                    ;; mode.
                                    (setq perp (if (zerop *TextRail:Mode*) 0.0 (/ pi 2.))
                                          jdx  -1
                                          ang  (angle bpt data)
                                          dis  (/ (distance bpt data)
                                                  (float (max 1 (1- (length objlst))))
                                               )
                                    )

                                    ;; SHIFT held: rotate the text square to
                                    ;; the rail as it is dragged.
                                    (if (and expresstools (acet-sys-shift-down))
                                        (foreach obj objlst
                                            (vla-put-rotation obj (+ ang (/ pi 2.)))
                                        )
                                    )

                                    (grdraw bpt data col 1)

                                    (foreach obj objlst
                                        (setq prop
                                            (if (= "AcDbText" (vla-get-objectname obj))
                                                (if (= acalignmentleft (vla-get-alignment obj))
                                                    'insertionpoint
                                                    'textalignmentpoint
                                                )
                                                'insertionpoint
                                            )
                                        )
                                        (if (= 2 *TextRail:Mode*)
                                            ;; STRETCH: spread evenly along the rail.
                                            (vlax-put obj prop
                                                (polar bpt ang (* (setq jdx (1+ jdx)) dis))
                                            )
                                            ;; HORIZONTAL / VERTICAL: slide each
                                            ;; item along perp until it meets the
                                            ;; rail. inters finds that meeting
                                            ;; point; the trailing nil means the
                                            ;; two lines are treated as infinite,
                                            ;; so an item beyond the end of the
                                            ;; dragged rail still lands correctly.
                                            (progn
                                                (setq baspt (vlax-get obj prop))
                                                (if (setq iptn (inters bpt data
                                                                       (polar baspt perp 1) baspt
                                                                       nil))
                                                    (vlax-put obj prop iptn)
                                                )
                                            )
                                        )
                                    )
                                    t
                                )

                                ;;  ---- a key was pressed ----
                                (   (= 2 code)
                                    (cond

                                        ;;  Enter or Space: accept and finish.
                                        (   (vl-position data '(13 32)) nil)

                                        ;;  TAB: cycle mode.
                                        (   (= 9 data)
                                            (setq *TextRail:Mode*
                                                (if (= (1- (length modes)) *TextRail:Mode*)
                                                    0
                                                    (1+ *TextRail:Mode*)
                                                )
                                            )
                                            (TextRail:Prompt)
                                        )

                                        ;;  F8: ortho.
                                        (   (= 15 data)
                                            (setvar 'orthomode (- 1 (getvar 'orthomode)))
                                        )

                                        ;;  C: cycle the guide colour through 1-6.
                                        (   (vl-position data '(99 67))
                                            (setq col (1+ (rem col 6)))
                                        )

                                        ;;  S: fixed spacing instead of dragging.
                                        (   (vl-position data '(115 83))
                                            (if (= 2 *TextRail:Mode*)
                                                (princ "\nText cannot be spaced in stretch mode.")
                                                (progn
                                                    (initget 4)   ;; reject negative and zero
                                                    (setq *TextRail:Spacing*
                                                        (cond
                                                            (   (getdist
                                                                    (strcat "\nSpecify text spacing <"
                                                                            (vl-princ-to-string *TextRail:Spacing*)
                                                                            "> : ")
                                                                )
                                                            )
                                                            (   *TextRail:Spacing*)
                                                        )
                                                    )
                                                    ;; Re-sort along the axis the
                                                    ;; text now runs on, so the
                                                    ;; spacing is applied in the
                                                    ;; order the eye reads them.
                                                    (if (zerop perp)
                                                        (setq foo 'cadr bar '>)
                                                        (setq foo 'car  bar '<)
                                                    )
                                                    (setq tmplst (TextRail:Sort (TextRail:Anchors objlst) foo bar)
                                                          objlst (mapcar 'car tmplst)
                                                          jdx    0
                                                          baspt  (vlax-get (caar tmplst) (cadar tmplst))
                                                          basang (angle baspt
                                                                     (vlax-get (car (last tmplst))
                                                                               (cadr (last tmplst))
                                                                     )
                                                                 )
                                                    )
                                                    ;; First item stays; the rest
                                                    ;; step out from it at the
                                                    ;; fixed spacing.
                                                    (foreach obj (cdr objlst)
                                                        (setq prop
                                                            (if (= "AcDbText" (vla-get-objectname obj))
                                                                (if (= acalignmentleft (vla-get-alignment obj))
                                                                    'insertionpoint
                                                                    'textalignmentpoint
                                                                )
                                                                'insertionpoint
                                                            )
                                                        )
                                                        (vlax-put obj prop
                                                            (polar baspt basang
                                                                (* (setq jdx (1+ jdx)) *TextRail:Spacing*)
                                                            )
                                                        )
                                                    )
                                                )
                                            )
                                            (TextRail:Prompt)
                                        )

                                        ;;  R: rotation sub-loop.
                                        (   (vl-position data '(114 82))
                                            (TextRail:SetRotation)
                                            (TextRail:Prompt)
                                        )

                                        ;;  J: change justification of everything.
                                        (   (vl-position data '(74 106))
                                            (setq jlst '("TL" "TC" "TR" "ML" "MC" "MR" "BL" "BC" "BR"))
                                            (initget "TL TC TR ML MC MR BL BC BR")
                                            (setq *TextRail:Just*
                                                (1+
                                                    (vl-position
                                                        (cond
                                                            (   (getkword
                                                                    (strcat "\nSpecify text justification "
                                                                            "[TL/TC/TR/ML/MC/MR/BL/BC/BR] <"
                                                                            (nth (1- *TextRail:Just*) jlst)
                                                                            "> : ")
                                                                )
                                                            )
                                                            (   (nth (1- *TextRail:Just*) jlst))
                                                        )
                                                        jlst
                                                    )
                                                )
                                            )
                                            (foreach obj objlst
                                                (if (= "AcDbText" (vla-get-objectname obj))
                                                    ;; Text: the Alignment enum runs
                                                    ;; 6..14 for TL..BR, hence the +5.
                                                    ;; A left-justified object has no
                                                    ;; meaningful TextAlignmentPoint
                                                    ;; yet, so its InsertionPoint is
                                                    ;; copied across first -- without
                                                    ;; that the text would jump to
                                                    ;; the origin.
                                                    (if (= acalignmentleft (vla-get-alignment obj))
                                                        (progn
                                                            (setq baspt (vla-get-insertionpoint obj))
                                                            (vla-put-alignment obj (+ *TextRail:Just* 5))
                                                            (vla-put-textalignmentpoint obj baspt)
                                                        )
                                                        (vla-put-alignment obj (+ *TextRail:Just* 5))
                                                    )
                                                    ;; MText: AttachmentPoint runs 1..9
                                                    ;; in the same TL..BR order.
                                                    (vla-put-attachmentpoint obj *TextRail:Just*)
                                                )
                                            )
                                            (TextRail:Prompt)
                                        )

                                        ;;  O: switch to curve mode.
                                        (   (vl-position data '(79 111))

                                            ;; Pick a curve. vlax-curve-getEndParam
                                            ;; succeeds only on objects the curve
                                            ;; functions understand, which is the
                                            ;; cleanest possible test of "can I
                                            ;; string text along this?".
                                            (while
                                                (progn
                                                    (setq ent (car (entsel "\nSelect object to align text to <Exit> : ")))
                                                    (cond
                                                        (   (= 'ename (type ent))
                                                            (if (vl-catch-all-error-p
                                                                    (vl-catch-all-apply 'vlax-curve-getendparam (list ent))
                                                                )
                                                                (princ "\nInvalid object type selected.")
                                                            )
                                                        )
                                                        (   t (TextRail:Prompt) (setq ent nil))
                                                    )
                                                )
                                            )

                                            (if ent
                                                (progn
                                                    ;; Initial spacing spreads the
                                                    ;; items over the first half of
                                                    ;; the curve, leaving obvious
                                                    ;; room to drag either way.
                                                    (setq plst (TextRail:Anchors objlst)
                                                          k    0
                                                          fooc '1+
                                                          dspc (/ (- (vlax-curve-getdistatparam ent
                                                                         (vlax-curve-getendparam ent))
                                                                     (vlax-curve-getdistatparam ent
                                                                         (vlax-curve-getstartparam ent))
                                                                  )
                                                                  (* 2. (length objlst))
                                                               )
                                                    )

                                                    ;; Drop the first item onto the
                                                    ;; curve and lay the rest out
                                                    ;; from there.
                                                    (vlax-put (caar plst) (cadar plst)
                                                        (setq baspt (vlax-curve-getclosestpointto ent
                                                                        (vlax-get (caar plst) (cadar plst))
                                                                    )
                                                        )
                                                    )
                                                    (setq basdis (vlax-curve-getdistatpoint ent baspt))
                                                    (foreach item (cdr plst)
                                                        (if (setq pto (vlax-curve-getpointatdist ent
                                                                          (+ basdis (* (setq k ((eval fooc) k)) dspc))
                                                                      )
                                                            )
                                                            (vlax-put (car item) (cadr item) pto)
                                                        )
                                                    )

                                                    (princ (setq curvemsg
                                                        (strcat "\n[E]xit, Re[V]erse, Text [O]ffset, "
                                                                "[S]pace text, [SHIFT] align rotation, "
                                                                "[R]otation, [C]olour")
                                                    ))

                                                    ;; ---- curve mode drag loop ----
                                                    (while
                                                        (progn
                                                            (setq gr   (grread t 15 0)
                                                                  code (car  gr)
                                                                  data (cadr gr)
                                                            )
                                                            (redraw)
                                                            (cond
                                                                (   (and (= 5 code) (listp data))

                                                                    ;; The cursor sets both
                                                                    ;; the start position
                                                                    ;; along the curve and
                                                                    ;; the offset from it.
                                                                    (setq cpt    (vlax-curve-getclosestpointto ent data)
                                                                          k      0
                                                                          ang    (angle cpt data)
                                                                          basdis (vlax-curve-getdistatpoint ent cpt)
                                                                    )
                                                                    (grdraw cpt data col 1)

                                                                    (vlax-put (caar plst) (cadar plst)
                                                                        (polar cpt ang *TextRail:Offset*)
                                                                    )
                                                                    (if (and expresstools (acet-sys-shift-down))
                                                                        (vla-put-rotation (caar plst) (- ang (/ pi 2.)))
                                                                    )

                                                                    (setq tanfix
                                                                        (- (angle '(0 0 0)
                                                                               (vlax-curve-getfirstderiv ent
                                                                                   (vlax-curve-getparamatpoint ent cpt)
                                                                               )
                                                                           )
                                                                           ang
                                                                        )
                                                                    )

                                                                    (foreach item (cdr plst)
                                                                        (if (setq pto (vlax-curve-getpointatdist ent
                                                                                          (+ basdis (* (setq k ((eval fooc) k)) dspc))
                                                                                      )
                                                                            )
                                                                            (progn
                                                                                (setq cang
                                                                                    (if (vl-position (cdr (assoc 0 (entget ent)))
                                                                                                    '("XLINE" "LINE" "RAY"))
                                                                                        ang
                                                                                        (- (angle '(0 0 0)
                                                                                               (vlax-curve-getfirstderiv ent
                                                                                                   (vlax-curve-getparamatpoint ent pto)
                                                                                               )
                                                                                           )
                                                                                           tanfix
                                                                                        )
                                                                                    )
                                                                                )
                                                                                (vlax-put (car item) (cadr item)
                                                                                    (polar pto cang *TextRail:Offset*)
                                                                                )
                                                                                ;; Each item rotates to
                                                                                ;; its own local tangent,
                                                                                ;; not to a single shared
                                                                                ;; angle, so text wraps
                                                                                ;; properly around bends.
                                                                                (if (and expresstools (acet-sys-shift-down))
                                                                                    (vla-put-rotation (car item) (- cang (/ pi 2.)))
                                                                                )
                                                                            )
                                                                        )
                                                                    )
                                                                    t
                                                                )

                                                                (   (= 2 code)
                                                                    (cond
                                                                        (   (vl-position data '(114 82))
                                                                            (TextRail:SetRotation)
                                                                            (princ curvemsg)
                                                                        )
                                                                        (   (vl-position data '(99 67))
                                                                            (setq col (1+ (rem col 6)))
                                                                        )
                                                                        ;;  V: reverse the running
                                                                        ;;  order along the curve by
                                                                        ;;  flipping the step function.
                                                                        (   (vl-position data '(118 86))
                                                                            (setq fooc (if (= fooc '1+) '1- '1+))
                                                                        )
                                                                        (   (vl-position data '(79 111))
                                                                            (TextRail:SetOffset)
                                                                            (princ curvemsg)
                                                                        )
                                                                        (   (vl-position data '(83 115))
                                                                            (TextRail:SetSpacing)
                                                                            (princ curvemsg)
                                                                        )
                                                                        ;;  Enter or Space: accept.
                                                                        (   (vl-position data '(13 32)) nil)
                                                                        ;;  E: back to straight-line mode.
                                                                        (   (vl-position data '(69 101))
                                                                            (TextRail:Prompt)
                                                                            nil
                                                                        )
                                                                        (   t t)
                                                                    )
                                                                )

                                                                ;;  click or right-click: accept.
                                                                (   (and (= 3 code) (listp data)) nil)
                                                                (   (= 25 code) nil)
                                                                (   t t)
                                                            )
                                                        )
                                                    )
                                                    ;; Returning t here re-enters the
                                                    ;; straight-line loop only if the
                                                    ;; user pressed E; any other exit
                                                    ;; ends the command.
                                                    (and (vl-position data '(69 101)) t)
                                                )
                                                t
                                            )
                                        )

                                        (   t t)
                                    )
                                )

                                ;;  ---- click or right-click: accept and finish ----
                                (   (= 25 code) nil)
                                (   (and (= 3 code) (listp data)) nil)
                                (   t t)
                            )
                        )
                    )
                    (princ (strcat "\n" (itoa (length objlst)) " text objects aligned."))
                )
            )
        )
    )

    (TextRail:Restore)
    (princ)
)

(princ "\nTextRail loaded. Type TEXTRAIL to align text dynamically.")
(princ)

;;; ---------------------------------------------------------------------------
;;; End of file
;;; ---------------------------------------------------------------------------