;;; ---------------------------------------------------------------------------
;;; ViewLabel.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; VIEW, SECTION AND DETAIL TITLES
;;;
;;; PURPOSE
;;;   Places the title under a drawn view - VIEW A-A, SECTION B-B, DETAIL C -
;;;   with the pair of rules beneath it and an optional scale note.
;;;
;;;   It is a small job done many times per sheet, and doing it by hand is how
;;;   sheets end up with titles at three different heights and rules of four
;;;   different lengths.
;;;
;;; HOW IT WORKS
;;;   1. You pick the point the title should be centred on - normally directly
;;;      below the middle of the view it belongs to.
;;;
;;;   2. VIEW and SECTION titles repeat the identifying letter either side of a
;;;      dash, because they are cut on a line marked at both ends: a section
;;;      marked A at both ends is SECTION A-A. A DETAIL is called out at one
;;;      point only, so it takes a single letter.
;;;
;;;   3. THE RULES ARE MEASURED FROM THE TITLE, not fixed per type. The routine
;;;      this replaces carried a hard-coded half-width for each of the three
;;;      types, so "SECTION AA-AA" ran past its own underline while "DETAIL A"
;;;      sat in the middle of one far too long for it. Here the width comes from
;;;      the length of the text actually being written, plus a margin, so it is
;;;      right for any identifier.
;;;
;;;   4. Two rules rather than one, the lower slightly wider than the upper,
;;;      which is the conventional treatment and reads as deliberate rather than
;;;      as a doubled line.
;;;
;;; SIZE
;;;   Everything scales from DIMSCALE, so the title matches the dimensions on the
;;;   same sheet. Title text is DIMTXT times DIMSCALE times 1.35 - titles are set
;;;   slightly larger than dimension text - and the scale note is set smaller
;;;   again at 0.7 of the title.
;;;
;;;   VIEWLABEL  - place a view, section or detail title
;;; ---------------------------------------------------------------------------

;;; ---------------------------------------------------------------------------
;;; SESSION MEMORY
;;; ---------------------------------------------------------------------------

(if (null *ViewLabel:Prefs*)
    (setq *ViewLabel:Prefs*
        (list (cons "TYPE"  "Section")
              (cons "SCALE" "")          ; last scale note used, "" for none
        )
    )
)

(defun ViewLabel:Get ( key ) (cdr (assoc key *ViewLabel:Prefs*)))

(defun ViewLabel:Put ( key val )
    (setq *ViewLabel:Prefs*
        (cons (cons key val)
              (vl-remove-if '(lambda (p) (= (car p) key)) *ViewLabel:Prefs*)))
    val
)

;;; ---------------------------------------------------------------------------
;;; LAYER
;;; ---------------------------------------------------------------------------

(defun ViewLabel:Layer ( name )
    (if (tblsearch "layer" name)
        (command "_.LAYER" "_ON" name "_THAW" name "_UNLOCK" name "")
        (command "_.LAYER" "_NEW" name ""))
    (setvar "CLAYER" name)
)

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

(defun c:VIEWLABEL ( / *error* vars vals scl kind ref scale ip
                       height small title width r1 r2 y1 y2 y3 styleH )

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

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

    (setq scl (getvar "DIMSCALE"))
    (if (zerop scl) (setq scl 1.0))

    ;; A fixed-height text style overrides anything supplied, and the TEXT
    ;; command does not prompt for a height in that case.
    (setq styleH (cdr (assoc 40 (tblsearch "style" (getvar "TEXTSTYLE")))))
    (if (null styleH) (setq styleH 0.0))

    (setq height (if (> styleH 0.0) styleH (* scl (getvar "DIMTXT") 1.35)))
    (if (<= height 0.0) (setq height (* scl 0.12)))
    (setq small (* height 0.7))

    (initget "View Section Detail")
    (setq kind (getkword (strcat "\nLabel type [View/Section/Detail] <"
                                 (ViewLabel:Get "TYPE") ">: ")))
    (if (null kind) (setq kind (ViewLabel:Get "TYPE")))
    (ViewLabel:Put "TYPE" kind)

    (initget 1)
    (setq ref (strcase (getstring "\nIdentifying letter: ")))

    ;; A section or view is cut between two marks carrying the same letter, so
    ;; the title names both ends; a detail is called out at one place only.
    (setq title
        (if (= kind "Detail")
            (strcat "DETAIL " ref)
            (strcat (strcase kind) " " ref "-" ref)))

    (setq scale (getstring t (strcat "\nScale note <"
                                     (if (= (ViewLabel:Get "SCALE") "")
                                         "none" (ViewLabel:Get "SCALE"))
                                     ">, or . for none: ")))
    (cond ((= scale ".") (ViewLabel:Put "SCALE" "") (setq scale ""))
          ((= scale "")  (setq scale (ViewLabel:Get "SCALE")))
          (t             (ViewLabel:Put "SCALE" scale)))

    (setvar "BLIPMODE" 0)

    (while (setq ip (getpoint (strcat "\nCentre point for \"" title
                                      "\" <Enter to finish>: ")))
        (setvar "OSMODE" 0)

        ;; Rule width follows the title. Character width averages about 0.62 of
        ;; the height in the standard fonts; a margin of one height either side
        ;; keeps the rule clear of the last letter.
        (setq width (+ (* (strlen title) height 0.62) (* height 2.0))
              r1    (/ width 2.0)
              r2    (+ r1 (* height 0.25))   ; lower rule slightly wider
              y1    (- (cadr ip) (* height 0.55))
              y2    (- y1 (* height 0.30))
              y3    (- y2 (* height 1.30)))

        (ViewLabel:Layer "VIEWLABEL")

        (if (> styleH 0.0)
            (command "_.TEXT" "_J" "_BC" ip 0 title)
            (command "_.TEXT" "_J" "_BC" ip height 0 title))

        (command "_.LINE" (list (- (car ip) r1) y1) (list (+ (car ip) r1) y1) "")
        (command "_.LINE" (list (- (car ip) r2) y2) (list (+ (car ip) r2) y2) "")

        (if (/= scale "")
            (if (> styleH 0.0)
                (command "_.TEXT" "_J" "_TC" (list (car ip) y3) 0
                         (strcat "SCALE: " scale))
                (command "_.TEXT" "_J" "_TC" (list (car ip) y3) small 0
                         (strcat "SCALE: " scale))))

        (setvar "OSMODE" (nth (vl-position "OSMODE" vars) vals))
    )

    (ViewLabel:Restore)
    (princ)
)

(princ)