;;; ---------------------------------------------------------------------------
;;; StringDim.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; ARCHITECTURAL STRING DIMENSIONING
;;;
;;; PURPOSE
;;;   Puts a run of dimensions along one unbroken line, with oblique ticks at
;;;   each point and the figure centred in each gap - the way a floor plan is
;;;   dimensioned, and the way AutoCAD's own DIMCONTINUE does not do it.
;;;
;;;   DIMCONTINUE makes one dimension object per gap. Each carries its own
;;;   dimension line and its own pair of ticks, so every internal point ends up
;;;   with two ticks drawn on top of each other and the line is a row of
;;;   segments that never quite meet. Zoom in on a plotted drawing and it shows.
;;;   Here the line is drawn once, end to end, and each tick is drawn once.
;;;
;;;   The trade is that these are lines and text rather than dimension objects,
;;;   so they do not update if the plan moves. That is the accepted bargain for
;;;   this style of dimensioning, and it is why the routine exists.
;;;
;;; POINTS ARE PROJECTED ONTO THE LINE
;;;   You pick wall faces and openings wherever they happen to be. Every point
;;;   is then projected square onto the dimension line, so the string stays
;;;   perfectly straight even if the things being dimensioned are not quite in
;;;   line - which on a survey of an existing building they never are.
;;;
;;;   Extension lines are drawn from where you picked to the dimension line, so
;;;   it stays clear what each tick refers to.
;;;
;;; WHEN THE FIGURE WILL NOT FIT
;;;   A narrow gap - a 100mm upstand between two openings - cannot hold its own
;;;   figure. Those are written below the line instead, clear of the ticks. The
;;;   test is the estimated width of the text against the width of the gap.
;;;
;;; WHAT WAS FIXED
;;;   - No dimension line was ever drawn. The routine placed ticks and text and
;;;     nothing else, despite its own description promising "a continuous
;;;     un-fragmented dimension line". You had to draw it yourself.
;;;   - It finished by calling ECHO_OFF instead of ECHO_ON, so CMDECHO was left
;;;     at 0 - and the saved value was overwritten with 0 at the same moment, so
;;;     it could not be recovered. Every command for the rest of the session ran
;;;     silently.
;;;   - It set the running object snap to INTersection on entry and to NONe on
;;;     exit, throwing away whatever the user had set.
;;;   - Text was drawn with (command "text" <point> <rotation> <string>). When
;;;     the current text style has a fixed height that is right, but when the
;;;     style height is 0 - which is the usual setting - AutoCAD asks for a
;;;     height first, and the rotation was swallowed as the height. The text
;;;     then came out at whatever angle the string happened to look like.
;;;   - The dimension angle was measured once from the first two points and then
;;;     used to place every later figure, while the distances were measured
;;;     between the actual picked points. Any point off that first line put the
;;;     text somewhere it did not belong.
;;;   - Five variables were global, including single letters f, e and l.
;;;   - The source file was truncated part way through its closing comment.
;;;
;;;   STRINGDIM  - one continuous run of architectural dimensions
;;; ---------------------------------------------------------------------------

;;; ---------------------------------------------------------------------------
;;; GEOMETRY
;;; ---------------------------------------------------------------------------

;;; Project P square onto the line through B in direction ANG. This is what
;;; keeps the string straight when the picked points are not.
(defun StringDim:Project ( p b ang / dx dy along )
    (setq dx    (- (car p) (car b))
          dy    (- (cadr p) (cadr b))
          ;; Distance along the line is the dot product with the unit direction.
          along (+ (* dx (cos ang)) (* dy (sin ang))))
    (list (+ (car b) (* along (cos ang)))
          (+ (cadr b) (* along (sin ang)))
          0.0)
)

;;; The dimension figure, in the drawing's own units and precision.
(defun StringDim:Figure ( d ) (rtos d (getvar "LUNITS") (getvar "LUPREC")))

;;; Roughly how wide that figure will be drawn. Character width averages about
;;; three quarters of the height in the usual stroke fonts, which is close
;;; enough to decide whether a figure fits between two ticks.
(defun StringDim:Width ( d hgt ) (* (strlen (StringDim:Figure d)) hgt 0.75))

;;; ---------------------------------------------------------------------------
;;; DRAWING
;;; ---------------------------------------------------------------------------

(defun StringDim:Layer ( name colour )
    (if (not (tblsearch "LAYER" name))
        (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord")
                       '(100 . "AcDbLayerTableRecord") (cons 2 name)
                       '(70 . 0) (cons 62 colour) '(6 . "Continuous"))))
    name
)

(defun StringDim:Line ( p1 p2 layer )
    (entmake (list '(0 . "LINE") (cons 8 layer) (cons 10 p1) (cons 11 p2)))
)

;;; The oblique tick - a short stroke at 45 degrees to the dimension line,
;;; centred on the point. Architectural drawings use these rather than arrows.
(defun StringDim:Tick ( pt ang size layer )
    (StringDim:Line (polar pt (+ ang (/ pi 4.0)) size)
                    (polar pt (+ ang (/ pi 4.0) pi) size)
                    layer)
)

;;; Text made directly rather than through the TEXT command, which sidesteps
;;; the height prompt that appears only when the style height is zero - the
;;; thing that broke the original. Group 72 of 1 with 73 of 0 is centred on the
;;; baseline, and group 11 has to carry the point as well as group 10.
(defun StringDim:Text ( pt hgt rot txt layer )
    (entmake (list '(0 . "TEXT") (cons 8 layer)
                   (cons 10 pt) (cons 11 pt) (cons 40 hgt) (cons 1 txt)
                   (cons 50 rot) '(72 . 1) '(73 . 0)))
)

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

(defun c:STRINGDIM ( / *error* vars vals pts p base ang side lay hgt tick
                       proj i p1 p2 gap mid rot total n narrow txt off
                       first lastp v q pair )

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

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

    (setvar "CMDECHO" 0)
    (setvar "BLIPMODE" 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")

    ;; --- collect the points -------------------------------------------------
    ;; Object snap is left exactly as the user has it, because picking wall
    ;; faces and openings is precisely what running snaps are for.
    (princ "\nPick the points to dimension - wall faces, openings, grid lines.")
    (setq pts nil)
    (while (setq p (getpoint (strcat "\nPoint " (itoa (1+ (length pts)))
                                     (if (> (length pts) 1)
                                         " <Enter when done>" "") ": ")))
        (setq pts (cons (list (car p) (cadr p) 0.0) pts)))
    (setq pts (reverse pts))

    (if (< (length pts) 2)
        (princ "\nTwo points at least are needed.")
        (progn
            (setq first (car pts) lastp (car (reverse pts)))

            ;; --- which way does the string run ----------------------------
            (initget "Aligned Horizontal Vertical")
            (setq v (getkword "\nString direction [Aligned/Horizontal/Vertical] <Aligned>: "))
            (setq ang (cond ((= v "Horizontal") 0.0)
                            ((= v "Vertical")   (/ pi 2.0))
                            (t (angle first lastp))))

            ;; --- where does the dimension line sit ------------------------
            (setvar "OSMODE" 0)
            (setq side (getpoint first "\nWhere should the dimension line sit: "))

            (if (null side)
                (princ "\nCancelled.")
                (progn
                    (setq base (list (car side) (cadr side) 0.0))

                    ;; Text size from the style if it has one, otherwise from
                    ;; TEXTSIZE, and the user can override either.
                    (setq hgt (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))))
                    (if (or (null hgt) (<= hgt 0.0)) (setq hgt (getvar "TEXTSIZE")))
                    (if (or (null hgt) (<= hgt 0.0)) (setq hgt 2.5))
                    (initget 6)
                    (setq v (getdist (strcat "\nText height <" (rtos hgt 2 3) ">: ")))
                    (if v (setq hgt v))

                    (setq lay  (StringDim:Layer "Dimensions-String" 4)
                          tick (/ hgt 3.0)
                          ;; Each entry is (projected-point . point-as-picked).
                          ;; They are carried together because the sort below
                          ;; reorders them, and the extension lines still have
                          ;; to run back to the right originals.
                          proj (mapcar
                                   '(lambda ( q )
                                        (cons (StringDim:Project q base ang) q))
                                   pts))

                    ;; Sorted along the line, so points picked out of order
                    ;; still produce a sensible string.
                    (setq proj (vl-sort proj
                        '(lambda ( a b )
                            (< (+ (* (caar a) (cos ang)) (* (cadar a) (sin ang)))
                               (+ (* (caar b) (cos ang)) (* (cadar b) (sin ang)))))))

                    ;; --- the one continuous dimension line ------------------
                    ;; Run a little past the end ticks, as drawn by hand.
                    (StringDim:Line
                        (polar (caar proj) (+ ang pi) (* tick 1.5))
                        (polar (car (car (reverse proj))) ang (* tick 1.5))
                        lay)

                    ;; --- extension lines and ticks --------------------------
                    (foreach pair proj
                        (setq q (car pair) p (cdr pair))
                        (StringDim:Tick q ang tick lay)
                        ;; From the picked point to just past the dimension
                        ;; line, with a small gap at the picked end so the
                        ;; extension line does not touch the wall it measures.
                        (if (> (distance p q) (* hgt 0.5))
                            (StringDim:Line
                                (polar p (angle p q) (* hgt 0.5))
                                (polar q (angle p q) (* tick 1.0))
                                lay)))

                    ;; --- the figures ----------------------------------------
                    ;; Text reads left to right whichever way the string runs.
                    (setq rot ang)
                    (if (and (> rot (/ pi 2.0)) (< rot (* 1.5 pi)))
                        (setq rot (+ rot pi)))

                    (setq i 0 n 0 narrow 0 total 0.0)
                    (while (< i (1- (length proj)))
                        (setq p1  (car (nth i proj))
                              p2  (car (nth (1+ i) proj))
                              gap (distance p1 p2)
                              mid (polar p1 ang (/ gap 2.0))
                              txt (StringDim:Figure gap)
                              total (+ total gap))

                        (if (> (StringDim:Width gap hgt) gap)
                            ;; Too tight for the figure - drop it below the line
                            ;; and step it clear of the ticks.
                            (progn
                                (setq narrow (1+ narrow)
                                      off (polar mid (- ang (/ pi 2.0)) (* hgt 1.8)))
                                (StringDim:Text off hgt rot txt lay)
                                ;; A leader from the figure back to its gap, so
                                ;; there is no doubt which one it belongs to.
                                (StringDim:Line
                                    (polar mid (- ang (/ pi 2.0)) (* hgt 0.3))
                                    (polar mid (- ang (/ pi 2.0)) (* hgt 1.5))
                                    lay))
                            ;; Normal case - centred just above the line.
                            (StringDim:Text
                                (polar mid (+ ang (/ pi 2.0)) (* hgt 0.5))
                                hgt rot txt lay))

                        (setq n (1+ n) i (1+ i)))

                    (princ (strcat "\n" (itoa n) " dimension"
                                   (if (= n 1) "" "s") " on one line, overall "
                                   (StringDim:Figure total) "."))
                    (if (> narrow 0)
                        (princ (strcat "\n  " (itoa narrow)
                                       " too narrow for the figure - written below"
                                       " the line with a leader.")))
                )
            )
        )
    )

    (StringDim:Restore)
    (princ)
)

(princ)