;;; ---------------------------------------------------------------------------
;;; DimCentre.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; TURN A DIMENSION EXTENSION LINE INTO A CENTRELINE
;;;
;;; PURPOSE
;;;   When a dimension is taken to the centre of something - a hole, a column, a
;;;   pipe, a road - the extension line on that side ought to be drawn as a
;;;   centreline, not a continuous line. AutoCAD has no setting for it: extension
;;;   lines take the dimension's linetype and that is that.
;;;
;;;   Pick the extension line and this suppresses it, then draws a centreline
;;;   along exactly the same path, on the same layer, in the linetype you choose.
;;;   The dimension stays associative and keeps measuring; only its appearance
;;;   changes.
;;;
;;; HOW THE PATH IS FOUND
;;;   A linear dimension stores two definition points - the things being measured
;;;   - and a point on the dimension line itself. The extension line runs from
;;;   the definition point, square to the dimension line, until it crosses it and
;;;   a little way beyond.
;;;
;;;   So the far end is where a line from the definition point at right angles to
;;;   the dimension line meets a line through the dimension line point along it.
;;;   The two gaps at either end come from the dimension style: DIMEXO is how far
;;;   the extension line starts away from the thing measured, DIMEXE how far it
;;;   runs past the dimension line. Both scale with DIMSCALE.
;;;
;;; WHAT WAS FIXED
;;;   - It crashed on every rotated dimension. Working out the extension line
;;;     direction, it tested (= arad >90), where >90 was meant as a number but
;;;     is a symbol. Unbound symbols evaluate to nil in AutoLISP, so the test
;;;     became (= <angle> nil), and comparing a real with nil is a bad argument
;;;     type. Only dimensions at exactly zero rotation ever got past it.
;;;   - The extension line was suppressed by MOVING the dimension's definition
;;;     point. That works, but it edits the geometry the dimension measures from
;;;     in order to change how it looks. A DIMOVERRIDE of DIMSE1 or DIMSE2 turns
;;;     the extension line off and leaves the definition points alone.
;;;   - The linetype was loaded from acad.lin only. A metric drawing wants
;;;     acadiso.lin, and on those the load failed and the routine gave up.
;;;   - UNDO was driven as (command "undo" "e" "undo" "g") with no underscore
;;;     prefixes, so it failed on any non-English AutoCAD - and it ended a group
;;;     before starting one.
;;;   - The saved error handler was kept in a global called *e*, which any other
;;;     routine doing the same trick would overwrite.
;;;
;;;   DIMCENTRE  - draw a dimension extension line as a centreline
;;;   DIMCENTER  - the same command, spelled the other way
;;; ---------------------------------------------------------------------------

;;; Remembered between runs, so a drawing full of them takes one answer.
(setq *DimCentre:Ltype* nil
      *DimCentre:Scale* nil)

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

;;; Load a linetype, trying both the imperial and the metric definition file.
;;; Returns the name if it is available afterwards.
(defun DimCentre:Ltype ( name / )
    (if (not (tblsearch "LTYPE" name))
        (foreach file '("acad.lin" "acadiso.lin")
            (if (not (tblsearch "LTYPE" name))
                (vl-catch-all-apply
                    '(lambda ( )
                        (command "_.-LINETYPE" "_Load" name file ""))
                    '()))))
    (if (tblsearch "LTYPE" name) name)
)

;;; The direction the dimension line runs. Group 50 carries it for a rotated
;;; dimension; an aligned one has no rotation of its own and simply follows the
;;; two points it measures.
(defun DimCentre:DimAngle ( data / kind )
    (setq kind (logand 7 (cdr (assoc 70 data))))
    (if (= kind 1)
        (angle (cdr (assoc 13 data)) (cdr (assoc 14 data)))
        (cond ((cdr (assoc 50 data)))
              (t 0.0)))
)

;;; Where the extension line from ORIGIN crosses the dimension line. The
;;; extension line is square to the dimension line, so this is the intersection
;;; of two infinite lines - hence the nil, which tells INTERS not to care
;;; whether the crossing falls between the points given.
(defun DimCentre:Foot ( origin dimPt ang )
    (inters origin (polar origin (+ ang (/ pi 2.0)) 1.0)
            dimPt  (polar dimPt ang 1.0)
            nil)
)

;;; DIMEXO and DIMEXE for the style this dimension uses, already scaled. A
;;; dimension can override DIMSCALE itself, so the style is asked first and the
;;; drawing variable used only as a fallback.
(defun DimCentre:Gaps ( data / style scale exo exe )
    (setq style (tblsearch "DIMSTYLE" (cdr (assoc 3 data)))
          scale (cond ((cdr (assoc 40 style))) ((getvar "DIMSCALE")) (t 1.0))
          exo   (cond ((cdr (assoc 42 style))) (t 0.0625))
          exe   (cond ((cdr (assoc 44 style))) (t 0.18)))
    (if (<= scale 0.0) (setq scale 1.0))
    (list (* exo scale) (* exe scale))
)

(defun DimCentre:Line ( p1 p2 layer ltype scale )
    (entmake (list '(0 . "LINE") (cons 8 layer) (cons 6 ltype)
                   (cons 48 scale) (cons 10 p1) (cons 11 p2)))
)

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

(defun c:DIMCENTRE ( / *error* vars vals sel ent data kind ang p13 p14 p10
                       gaps exo exe near foot origin dir layer v done n
                       which ss )

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

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

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

    ;; --- settings, remembered from last time --------------------------------
    (if (null *DimCentre:Ltype*)
        (setq *DimCentre:Ltype* (cond ((DimCentre:Ltype "CENTER2"))
                                      ((DimCentre:Ltype "CENTER"))
                                      (t "CONTINUOUS"))))
    (if (null *DimCentre:Scale*) (setq *DimCentre:Scale* 1.0))

    (setq done nil n 0)

    (while (not done)
        (setvar "OSMODE" 0)
        (initget "Ltype Scale")
        (setq sel (entsel (strcat "\nExtension line to make a centreline"
                                  " [Ltype/Scale] <Enter to finish>: ")))
        ;; ENTSEL with keywords hands back a string if one was typed and a
        ;; (name point) list if something was picked, so the type has to be
        ;; checked before comparing - = is for numbers and strings, and will
        ;; not take a list.
        (cond
            ((null sel) (setq done t))

            ((and (= 'STR (type sel)) (= sel "Ltype"))
             (setq v (getstring (strcat "\nLinetype <" *DimCentre:Ltype* ">: ")))
             (if (/= "" v)
                 (if (DimCentre:Ltype v)
                     (setq *DimCentre:Ltype* v)
                     (princ (strcat "\n  " v " is not in acad.lin or acadiso.lin.")))))

            ((and (= 'STR (type sel)) (= sel "Scale"))
             (initget 6)
             (setq v (getreal (strcat "\nLinetype scale <"
                                      (rtos *DimCentre:Scale* 2 4) ">: ")))
             (if v (setq *DimCentre:Scale* v)))

            ((= 'LIST (type sel))
                (setq ent  (car sel)
                      data (entget ent))

                (if (/= "DIMENSION" (cdr (assoc 0 data)))
                    (princ "\n  That is not a dimension.")
                    (progn
                        (setq kind (logand 7 (cdr (assoc 70 data))))
                        (if (not (member kind '(0 1)))
                            (princ "\n  Only linear and aligned dimensions have"
                                   " extension lines that can be replaced.")
                            (progn
                                (setq ang  (DimCentre:DimAngle data)
                                      p13  (cdr (assoc 13 data))
                                      p14  (cdr (assoc 14 data))
                                      p10  (cdr (assoc 10 data))
                                      gaps (DimCentre:Gaps data)
                                      exo  (car gaps)
                                      exe  (cadr gaps)
                                      layer (cdr (assoc 8 data)))

                                ;; Which of the two extension lines was picked -
                                ;; whichever definition point the pick lies
                                ;; nearer to, measured along the dimension.
                                (setq near (cadr sel))
                                (if (< (distance near p13) (distance near p14))
                                    (setq origin p13 which "DIMSE1")
                                    (setq origin p14 which "DIMSE2"))

                                (setq foot (DimCentre:Foot origin p10 ang))

                                (if (or (null foot)
                                        (equal (distance origin foot) 0.0 1e-9))
                                    (princ "\n  That extension line has no length"
                                           " to draw along.")
                                    (progn
                                        (setq dir (angle origin foot))

                                        ;; Turn the dimension's own extension
                                        ;; line off, leaving the definition
                                        ;; points untouched.
                                        (setq ss (ssadd ent (ssadd)))
                                        (command "_.DIMOVERRIDE" which 1 "" ss "")

                                        ;; And draw the centreline along exactly
                                        ;; the path it used to take.
                                        (DimCentre:Line
                                            (polar origin dir exo)
                                            (polar foot dir exe)
                                            layer *DimCentre:Ltype* *DimCentre:Scale*)

                                        (setq n (1+ n))
                                        (princ (strcat "  " *DimCentre:Ltype*
                                                       " at scale "
                                                       (rtos *DimCentre:Scale* 2 4))))))))))
        )
    )

    (princ (strcat "\n" (itoa n) " extension line"
                   (if (= n 1) "" "s") " replaced."))

    (DimCentre:Restore)
    (princ)
)

;;; The other spelling, for anyone who reaches for it.
(defun c:DIMCENTER ( ) (c:DIMCENTRE))

(princ)