;;; ---------------------------------------------------------------------------
;;; TextRank.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Aligns a group of single-line text objects onto a common line, optionally
;;; equispacing them at a chosen multiple of the text height.
;;;
;;; Pick a scattered set of labels and they snap into a tidy column, aligned in
;;; the direction perpendicular to their own rotation - so rotated text aligns
;;; along its own axis rather than being forced to horizontal.
;;;
;;; TWO MODES, CHOSEN AT THE SPACING PROMPT
;;;   Press Enter        - text is aligned but each object keeps its existing
;;;                        position along the line. Use this to straighten a
;;;                        column that is already correctly spaced.
;;;   Enter a factor     - text is aligned AND equispaced, at that multiple of
;;;                        the text height. A factor of 1.5 gives one and a half
;;;                        line spacing, which is a common annotation standard.
;;;
;;; WHICH TEXT STAYS PUT
;;; The first object in the sorted order - the one furthest along the alignment
;;; axis - is treated as the anchor and does not move. Everything else lines up
;;; to it. So position that one where you want the column to start.
;;;
;;; The routine assumes every text object in the selection shares the same
;;; rotation, and takes its alignment axis from the last object selected.
;;;
;;;   TEXTRANK  - align and optionally equispace single-line text
;;; ---------------------------------------------------------------------------

(vl-load-com)

;; ---------------------------------------------------------------------------
;; TextRank:InsertionKey
;; ---------------------------------------------------------------------------
;; Returns which DXF group actually holds a TEXT object's position.
;;
;; This is a genuine trap in AutoCAD's data model. A TEXT entity carries TWO
;; position groups:
;;
;;   10 - the insertion point, used when the text is left-justified
;;   11 - the alignment point, used for every other justification
;;
;; Which one is live depends on groups 72 and 73, the horizontal and vertical
;; justification codes. When BOTH are zero the text is plain left-baseline and
;; group 10 governs; otherwise group 11 does and group 10 is stale.
;;
;; Reading or writing the wrong one is why naive alignment routines appear to
;; work on some text and silently do nothing on the rest.
;; ---------------------------------------------------------------------------
(defun TextRank:InsertionKey ( enx )
    (if (and (zerop (cdr (assoc 72 enx)))
             (zerop (cdr (assoc 73 enx)))
        )
        10
        11
    )
)

;; Reads the live insertion point.
(defun TextRank:GetInsertion ( enx )
    (cdr (assoc (TextRank:InsertionKey enx) enx))
)

;; ---------------------------------------------------------------------------
;; TextRank:PutInsertion
;; ---------------------------------------------------------------------------
;; Writes a new insertion point to whichever group is live for this text.
;;
;; entupd is called after entmod because text inside a block reference will not
;; redraw from entmod alone.
;; ---------------------------------------------------------------------------
(defun TextRank:PutInsertion ( ins enx / key )
    (setq key (TextRank:InsertionKey enx))
    (if (entmod (subst (cons key ins) (assoc key enx) enx))
        (entupd (cdr (assoc -1 enx)))
    )
)

;; ---------------------------------------------------------------------------
;; c:TEXTRANK  -  main routine
;; ---------------------------------------------------------------------------
(defun c:TEXTRANK ( / *error* vars vals sel ang enx idx ins lst ocs spf
                      vc1 vc2 bp1 bp2 itm count )

    (setq vars '("CMDECHO")
          vals (mapcar 'getvar vars)
    )

    (defun TextRank: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 )
        (TextRank:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** TEXTRANK error: " msg " **"))
        )
        (princ)
    )

    (setvar "CMDECHO" 0)

    ;; "_:L" excludes locked layers, whose text could not be moved anyway.
    (if (setq sel (ssget "_:L" '((0 . "TEXT"))))
        (progn
            ;; initget 6 forbids zero and negative input - a spacing factor of
            ;; zero would stack every label on top of the next.
            (initget 6)
            (setq spf (getdist "\nSpecify line spacing factor <use existing>: ")
                  idx (sslength sel)
                  enx (entget (ssname sel (1- idx)))
                  ang (cdr (assoc 50 enx))
                  ocs (trans '(0.0 0.0 1.0) 1 0 t)
            )

            ;; ---------------------------------------------------------------
            ;; Build two orthogonal reference axes from the text rotation:
            ;;   vc1 runs ALONG the text direction - the alignment line
            ;;   vc2 runs ACROSS it - the axis objects are distributed along
            ;;
            ;; Working in these rotated axes rather than in world X and Y is
            ;; what allows the routine to handle text at any angle, and text
            ;; built in any UCS, with the same arithmetic.
            ;; ---------------------------------------------------------------
            (setq vc1 (trans (list    (cos ang)  (sin ang)) ocs 0)
                  vc2 (trans (list (- (sin ang)) (cos ang)) ocs 0)
                  ;; Spacing is expressed as a multiple of the text height.
                  spf (if spf (* (cdr (assoc 40 enx)) spf))
            )

            ;; Collect every object as (worldInsertionPoint . entityData), and
            ;; separately collect its position along the across-axis so the set
            ;; can be sorted into visual order.
            (repeat idx
                (setq enx (entget (ssname sel (setq idx (1- idx))))
                      lst (cons (list (trans (TextRank:GetInsertion enx)
                                             (cdr (assoc -1 enx))
                                             0
                                      )
                                      enx
                                )
                                lst
                          )
                      ins (cons (caddr (trans (caar lst) 0 vc2)) ins)
                )
            )

            ;; Sort descending along the across-axis, so the topmost object
            ;; comes first and becomes the anchor.
            (setq lst (mapcar (function (lambda ( n ) (nth n lst)))
                              (vl-sort-i ins '>)
                      )
                  ;; bp1 fixes the alignment line; bp2 tracks the running
                  ;; position when equispacing.
                  bp1 (caddr (trans (caar lst) 0 vc1))
                  bp2 (caddr (trans (caar lst) 0 vc2))
                  count 0
            )

            ;; AutoCAD 2015 and later refuse (command) inside an *error* handler
            ;; unless the routine says up front that it will use one. Restore does,
            ;; to close this undo group. The declaring call is absent on older
            ;; releases, so it is wrapped rather than tested for.
            (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
            (command "_.UNDO" "_Begin")

            ;; cdr skips the anchor, which by definition does not move.
            (foreach itm (cdr lst)
                (if spf
                    ;; Equispaced: step the across-axis position down by one
                    ;; spacing interval for each successive object.
                    (setq ins (trans (car itm) 0 vc2)
                          ins (trans (list (car ins) (cadr ins) (- bp2 spf)) vc2 vc1)
                          bp2 (- bp2 spf)
                    )
                    ;; Aligned only: keep the object's existing position along
                    ;; the across-axis, and change only its alignment.
                    (setq ins (trans (car itm) 0 vc1))
                )

                ;; Substituting bp1 as the third ordinate is what performs the
                ;; alignment - every object ends up at the same distance along
                ;; the alignment axis, whatever it was before.
                (TextRank:PutInsertion
                    (trans (list (car ins) (cadr ins) bp1)
                           vc1
                           (cdr (assoc -1 (cadr itm)))
                    )
                    (cadr itm)
                )
                (setq count (1+ count))
            )

            (princ (strcat "\n" (itoa count)
                           " text object" (if (= 1 count) "" "s") " aligned"
                           (if spf " and equispaced." ".")
                   )
            )
        )
        (princ "\nNo text selected.")
    )

    (TextRank:Restore)
    (princ)
)

(princ)