;;; SmartScaleBar v2.0
;;; Mouse-driven scale bar for AutoCAD / AutoCAD LT 2026+
;;;
;;; Commands:
;;;   SBAR - unified New/Edit command.
;;;          Edit supports preset size factors, Manual resize, Keep size,
;;;          TEXT SIZE, and BAR THICKNESS.
;;;
;;; SBAR asks only for display unit [M/FT], default M.
;;; One drawing unit is treated as one selected real-world unit:
;;;   30 drawing units + M  -> 30 m
;;;   30 drawing units + FT -> 30 ft
;;;
;;; IMPORTANT: Use SBAR > Edit to resize an existing bar so labels are recalculated.
;;; Manual SCALE stretches geometry/text and does not change the represented distance.

(setq *sb:version* "2.0")
(setq *sb:counter* (if (boundp '*sb:counter*) *sb:counter* 0))
(setq *sb:text-size* (if (boundp '*sb:text-size*) *sb:text-size* 2.5))
(setq *sb:bar-thickness* (if (boundp '*sb:bar-thickness*) *sb:bar-thickness* 3.0))

(defun sb:pt (x y) (list x y 0.0))

(defun sb:unique-block-name ( / n name)
  (setq n (1+ *sb:counter*))
  (setq name (strcat "SBAR_" (itoa n)))
  (while (tblsearch "BLOCK" name)
    (setq n (1+ n))
    (setq name (strcat "SBAR_" (itoa n)))
  )
  (setq *sb:counter* n)
  name
)

(defun sb:choose-unit ( / ans)
  (initget "M FT")
  (setq ans (getkword "\nDistance units [M/FT] <M>: "))
  (if (= ans "FT") "ft" "m")
)

(defun sb:data-suffix (data / n)
  ;; XData ends in |m or |ft. Preserve the selected unit when SBE rebuilds.
  (if (and data (> (strlen data) 2))
    (progn
      (setq n (strlen data))
      (if (and (>= n 3) (= (substr data (- n 2) 3) "|ft"))
        "ft"
        "m"
      )
    )
    "m"
  )
)

(defun sb:format-number (v / s)
  (cond
    ((< (abs v) 0.0000001) "0")
    ((< (abs (- v (fix v))) 0.0000001)
      (rtos v 2 0))
    (T
      (setq s (rtos v 2 2))
      (while (and (> (strlen s) 0) (= (substr s (strlen s) 1) "0"))
        (setq s (substr s 1 (1- (strlen s))))
      )
      (if (and (> (strlen s) 0) (= (substr s (strlen s) 1) "."))
        (setq s (substr s 1 (1- (strlen s))))
      )
      s
    )
  )
)

(defun sb:label (v suffix)
  ;; Metric labels switch to kilometres at 1000 m and above.
  ;; Feet remain unchanged.
  (if (and (= suffix "m") (>= v 1000.0))
    (strcat (sb:format-number (/ v 1000.0)) "km")
    (strcat (sb:format-number v) suffix)
  )
)

(defun sb:begin-block (name)
  (entmake
    (list
      '(0 . "BLOCK")
      '(100 . "AcDbEntity")
      '(8 . "0")
      '(100 . "AcDbBlockBegin")
      (cons 2 name)
      (cons 70 0)
      (cons 10 (sb:pt 0.0 0.0))
      (cons 3 name)
      (cons 1 "")
    )
  )
)

(defun sb:end-block ()
  (entmake
    (list
      '(0 . "ENDBLK")
      '(100 . "AcDbEntity")
      '(8 . "0")
      '(100 . "AcDbBlockEnd")
    )
  )
)

(defun sb:line (x1 y1 x2 y2)
  (entmake
    (list
      '(0 . "LINE")
      '(100 . "AcDbEntity")
      '(8 . "0")
      '(62 . 7)
      '(100 . "AcDbLine")
      (cons 10 (sb:pt x1 y1))
      (cons 11 (sb:pt x2 y2))
    )
  )
)

(defun sb:rect (x1 y1 x2 y2 /)
  (entmake
    (list
      '(0 . "LWPOLYLINE")
      '(100 . "AcDbEntity")
      '(8 . "0")
      '(62 . 7)
      '(100 . "AcDbPolyline")
      (cons 90 4)
      (cons 70 1)
      (cons 10 (list x1 y1))
      (cons 10 (list x2 y1))
      (cons 10 (list x2 y2))
      (cons 10 (list x1 y2))
    )
  )
)

(defun sb:solid (x1 y1 x2 y2)
  (entmake
    (list
      '(0 . "SOLID")
      '(100 . "AcDbEntity")
      '(8 . "0")
      '(62 . 7)
      '(100 . "AcDbTrace")
      (cons 10 (sb:pt x1 y1))
      (cons 11 (sb:pt x2 y1))
      (cons 12 (sb:pt x1 y2))
      (cons 13 (sb:pt x2 y2))
    )
  )
)

(defun sb:white-solid (x1 y1 x2 y2)
  ;; Opaque white background behind the entire scale bar for readability on imagery.
  (entmake
    (list
      '(0 . "SOLID")
      '(100 . "AcDbEntity")
      '(8 . "0")
      '(62 . 7)
      '(420 . 16777215)
      '(100 . "AcDbTrace")
      (cons 10 (sb:pt x1 y1))
      (cons 11 (sb:pt x2 y1))
      (cons 12 (sb:pt x1 y2))
      (cons 13 (sb:pt x2 y2))
    )
  )
)

(defun sb:text-center (x y h txt)
  (entmake
    (list
      '(0 . "TEXT")
      '(100 . "AcDbEntity")
      '(8 . "0")
      '(62 . 7)
      '(100 . "AcDbText")
      (cons 10 (sb:pt x y))
      (cons 40 h)
      (cons 1 txt)
      (cons 50 0.0)
      (cons 72 1)
      (cons 11 (sb:pt x y))
      (cons 100 "AcDbText")
      (cons 73 2)
    )
  )
)

(defun sb:text-left (x y h txt)
  ;; Left aligned, vertically middle aligned at x/y.
  (entmake
    (list
      '(0 . "TEXT")
      '(100 . "AcDbEntity")
      '(8 . "0")
      '(62 . 7)
      '(100 . "AcDbText")
      (cons 10 (sb:pt x y))
      (cons 40 h)
      (cons 1 txt)
      (cons 50 0.0)
      (cons 72 0)
      (cons 11 (sb:pt x y))
      (cons 100 "AcDbText")
      (cons 73 2)
    )
  )
)

(defun sb:text-right (x y h txt)
  ;; Right aligned, vertically middle aligned at x/y.
  (entmake
    (list
      '(0 . "TEXT")
      '(100 . "AcDbEntity")
      '(8 . "0")
      '(62 . 7)
      '(100 . "AcDbText")
      (cons 10 (sb:pt x y))
      (cons 40 h)
      (cons 1 txt)
      (cons 50 0.0)
      (cons 72 2)
      (cons 11 (sb:pt x y))
      (cons 100 "AcDbText")
      (cons 73 2)
    )
  )
)

(defun sb:make-data (width total factor suffix)
  (strcat
    "V2|"
    (rtos width 2 8) "|"
    (rtos total 2 8) "|"
    (rtos factor 2 12) "|"
    suffix
  )
)

(defun sb:get-xdata-string (ename / xd app item)
  (setq xd (assoc -3 (entget ename '("SBAR_DATA"))))
  (if xd
    (progn
      (setq app (cadr xd))
      (setq item (cadr app))
      (if (and item (= (car item) 1000)) (cdr item) nil)
    )
    nil
  )
)

(defun sb:data-width (data / i j token)
  ;; Reads stored width from old/current V2 XData:
  ;; V2|width|total|factor|unit
  (if (and data (> (strlen data) 3))
    (progn
      (setq i 4)
      (setq j i)
      (while (and (<= j (strlen data)) (/= (substr data j 1) "|"))
        (setq j (1+ j))
      )
      (if (> j i)
        (progn
          (setq token (substr data i (- j i)))
          (atof token)
        )
        nil
      )
    )
    nil
  )
)

(defun sb:build-definition (name width total suffix / divs step barh halfh texth gap ytxt labelpad bgpadx bgpady bgx1 bgx2 bgy1 bgy2 i x1 x2 v)
  (setq divs 5)
  (setq step (/ width 5.0))

  ;; User-controlled appearance. These values stay constant regardless of bar length.
  (setq barh *sb:bar-thickness*)
  (setq texth *sb:text-size*)
  (setq gap (* texth 0.55))
  (if (< gap 0.5) (setq gap 0.5))

  (setq halfh (/ barh 2.0))

  ;; Put labels a little closer to the bar so the total panel height stays compact.
  ;; Text is middle-aligned, so use less than half-text spacing.
  (setq ytxt (- (+ gap (* texth 0.38))))

  ;; Compact white background mask around the true content extents.
  ;; Keep enough horizontal room so the first/last labels stay inside the panel.
  (setq labelpad (* texth 0.35))
  (setq bgpadx (max (* gap 0.75) labelpad))
  (setq bgpady (max gap (* texth 0.28)))
  (setq bgx1 (- bgpadx))
  (setq bgx2 (+ width bgpadx))

  ;; Lower limit: label center minus about half text height, plus a small pad.
  ;; Upper limit: top of bar plus the same compact pad.
  (setq bgy1 (- ytxt (* texth 0.62) bgpady))
  (setq bgy2 (+ barh bgpady))

  (sb:begin-block name)
  (sb:white-solid bgx1 bgy1 bgx2 bgy2)
  ;; Black border around the white background panel.
  (sb:rect bgx1 bgy1 bgx2 bgy2)

  ;; Two-row alternating black/white appearance.
  (setq i 0)
  (while (< i divs)
    (setq x1 (* i step))
    (setq x2 (* (1+ i) step))
    (if (= 0 (rem i 2))
      (sb:solid x1 halfh x2 barh)
      (sb:solid x1 0.0 x2 halfh)
    )
    (setq i (1+ i))
  )

  ;; Outer box, middle line, and exact five equal divisions.
  (sb:rect 0.0 0.0 width barh)
  (sb:line 0.0 halfh width halfh)
  (setq i 1)
  (while (< i divs)
    (setq x1 (* i step))
    (sb:line x1 0.0 x1 barh)
    (setq i (1+ i))
  )

  ;; Labels at 0/5, 1/5 ... 5/5.
  ;; End labels are aligned inward so short bars do not need oversized side margins.
  (setq i 0)
  (while (<= i divs)
    (setq x1 (* i step))
    (setq v (* total (/ (float i) 5.0)))
    (cond
      ((= i 0)    (sb:text-left 0.0 ytxt texth (sb:label v suffix)))
      ((= i divs) (sb:text-right width ytxt texth (sb:label v suffix)))
      (T           (sb:text-center x1 ytxt texth (sb:label v suffix)))
    )
    (setq i (1+ i))
  )

  (sb:end-block)
)

(defun sb:insert-block (name ins ang data / ed)
  (regapp "SBAR_DATA")
  (setq ed
    (list
      '(0 . "INSERT")
      '(100 . "AcDbEntity")
      '(8 . "0")
      '(62 . 256)
      '(100 . "AcDbBlockReference")
      (cons 2 name)
      (cons 10 ins)
      (cons 41 1.0)
      (cons 42 1.0)
      (cons 43 1.0)
      (cons 50 ang)
      (list -3 (list "SBAR_DATA" (cons 1000 data)))
    )
  )
  (entmake ed)
  (entlast)
)

(defun sb:bring-to-front (ename / oldcmd)
  ;; Force the complete scale-bar block above images/hatches/other objects.
  (if (and ename (entget ename))
    (progn
      (setq oldcmd (getvar "CMDECHO"))
      (setvar "CMDECHO" 0)
      (command "_.DRAWORDER" ename "" "_Front")
      (setvar "CMDECHO" oldcmd)
    )
  )
  ename
)

(defun sb:create-from-points (p1 p2 suffix / width ang factor total name data)
  (setq width (distance p1 p2))
  (if (> width 0.0000001)
    (progn
      (setq ang (angle p1 p2))
      (setq factor 1.0)
      (setq total width)
      (setq name (sb:unique-block-name))
      (sb:build-definition name width total suffix)
      (setq data (sb:make-data width total factor suffix))
      (sb:bring-to-front (sb:insert-block name p1 ang data))
      (princ
        (strcat
          "\nScale bar: " (sb:format-number total) suffix
          " / 5 equal divisions = " (sb:format-number (/ total 5.0)) suffix " each."
        )
      )
      T
    )
    nil
  )
)

(defun sb:cmd-new ( / *error* olderr suffix p1 p2)
  (setq olderr *error*)
  (defun *error* (msg)
    (if (and msg (/= msg "Function cancelled") (/= msg "quit / exit abort"))
      (princ (strcat "\nSBAR error: " msg))
    )
    (setq *error* olderr)
    (princ)
  )

  (setq suffix (sb:choose-unit))
  (setq p1 (getpoint "\nPick START point: "))
  (if p1
    (progn
      (setq p2 (getpoint p1 "\nPick END point: "))
      (if p2
        (if (not (sb:create-from-points p1 p2 suffix))
          (princ "\nStart and end points must be different.")
        )
      )
    )
  )

  (setq *error* olderr)
  (princ)
)


(defun sb:get-current-appearance (ename / ed bname btr e d typ tsize bth ymin ymax pts p)
  ;; Read actual text height and bar thickness from the selected block definition.
  ;; This keeps preset multipliers relative to the selected scale bar, not global defaults.
  (setq tsize nil)
  (setq bth nil)
  (setq ed (entget ename))
  (setq bname (cdr (assoc 2 ed)))
  (if bname
    (progn
      (setq btr (tblobjname "BLOCK" bname))
      (setq e (if btr (entnext btr) nil))
      (while (and e (or (null tsize) (null bth)))
        (setq d (entget e))
        (setq typ (cdr (assoc 0 d)))
        (cond
          ((and (= typ "TEXT") (null tsize))
            (setq tsize (cdr (assoc 40 d)))
          )
          ;; First non-white SOLID is one half-row of the scale bar.
          ;; Its Y height x2 equals full bar thickness.
          ((and (= typ "SOLID") (null bth) (null (assoc 420 d)))
            (setq pts
              (list
                (cdr (assoc 10 d))
                (cdr (assoc 11 d))
                (cdr (assoc 12 d))
                (cdr (assoc 13 d))
              )
            )
            (setq ymin nil ymax nil)
            (foreach p pts
              (if p
                (progn
                  (if (or (null ymin) (< (cadr p) ymin)) (setq ymin (cadr p)))
                  (if (or (null ymax) (> (cadr p) ymax)) (setq ymax (cadr p)))
                )
              )
            )
            (if (and ymin ymax (> (- ymax ymin) 0.0))
              (setq bth (* 2.0 (- ymax ymin)))
            )
          )
        )
        (if (/= typ "ENDBLK") (setq e (entnext e)) (setq e nil))
      )
    )
  )
  (list
    (if tsize tsize *sb:text-size*)
    (if bth bth *sb:bar-thickness*)
  )
)

(defun sb:cmd-edit ( / *error* olderr sel en ed data ins oldrot oldwidth mode mult app curtext curbar width ang factor suffix total name newdata v)
  (setq olderr *error*)
  (defun *error* (msg)
    (if (and msg (/= msg "Function cancelled") (/= msg "quit / exit abort"))
      (princ (strcat "\nSBAR Edit error: " msg))
    )
    (setq *error* olderr)
    (princ)
  )

  (setq sel (entsel "\nSelect scale bar to edit: "))
  (if sel
    (progn
      (setq en (car sel))
      (setq ed (entget en))
      (setq data (sb:get-xdata-string en))
      (if (and (= (cdr (assoc 0 ed)) "INSERT") data)
        (progn
          (setq ins (cdr (assoc 10 ed)))
          (setq oldrot (if (assoc 50 ed) (cdr (assoc 50 ed)) 0.0))
          (setq oldwidth (sb:data-width data))
          (setq width oldwidth)
          (setq ang oldrot)

          ;; Read the selected bar's actual appearance so multipliers are relative.
          (setq app (sb:get-current-appearance en))
          (setq curtext (car app))
          (setq curbar (cadr app))

          (initget "0.5x 0.75x 0.9x 1.25x 1.5x 2x Manual Keep")
          (setq mode
            (getkword
              "\nText + Bar size [0.5x/0.75x/0.9x/1.25x/1.5x/2x/Manual/Keep] <Keep>: "
            )
          )
          (if (null mode) (setq mode "Keep"))

          (cond
            ((= mode "0.5x")  (setq mult 0.5))
            ((= mode "0.75x") (setq mult 0.75))
            ((= mode "0.9x")  (setq mult 0.9))
            ((= mode "1.25x") (setq mult 1.25))
            ((= mode "1.5x")  (setq mult 1.5))
            ((= mode "2x")    (setq mult 2.0))
            (T                  (setq mult nil))
          )

          (cond
            ;; Presets affect appearance only. Length and represented distance stay unchanged.
            (mult
              (setq *sb:text-size* (* curtext mult))
              (setq *sb:bar-thickness* (* curbar mult))
            )
            ;; Manual keeps the previous numeric workflow.
            ((= mode "Manual")
              (setq *sb:text-size* curtext)
              (setq *sb:bar-thickness* curbar)
              (initget 6)
              (setq v (getreal (strcat "\nTEXT SIZE <" (rtos curtext 2 2) ">: ")))
              (if v (setq *sb:text-size* v))
              (initget 6)
              (setq v (getreal (strcat "\nBAR THICKNESS <" (rtos curbar 2 2) ">: ")))
              (if v (setq *sb:bar-thickness* v))
            )
            ;; Keep means no appearance change.
            (T
              (setq *sb:text-size* curtext)
              (setq *sb:bar-thickness* curbar)
            )
          )

          (if (and width (> width 0.0000001))
            (progn
              (setq factor 1.0)
              (setq suffix (sb:data-suffix data))
              (setq total width)
              (setq name (sb:unique-block-name))
              (sb:build-definition name width total suffix)
              (setq newdata (sb:make-data width total factor suffix))
              (entdel en)
              (sb:bring-to-front (sb:insert-block name ins ang newdata))
              (princ
                (strcat
                  "\nScale bar updated (" mode "). Text Size = " (rtos *sb:text-size* 2 2)
                  ", Bar Thickness = " (rtos *sb:bar-thickness* 2 2) "."
                )
              )
            )
            (princ "\nCould not read the scale-bar length.")
          )
        )
        (princ "\nSelected object is not a scale bar created by SBAR.")
      )
    )
  )

  (setq *error* olderr)
  (princ)
)

(defun c:SBAR ( / mode)
  (initget "New Edit")
  (setq mode (getkword "\nScale bar [New/Edit] <New>: "))
  (cond
    ((or (null mode) (= mode "New"))
      (sb:cmd-new)
    )
    ((= mode "Edit")
      (sb:cmd-edit)
    )
  )
  (princ)
)

(princ "
SmartScaleBar Version 2.0 loaded. Use SBAR for New or Edit.")
(princ)