;;; ---------------------------------------------------------------------------
;;; Barb.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Draws leader-style arrows as plain polylines, sized automatically from the
;;; drawing's own dimension settings.
;;;
;;; The arrowhead length is DIMASZ multiplied by DIMSCALE - exactly the size
;;; AutoCAD would use for a real dimension arrowhead in the current annotation
;;; scale. That is the whole point of these commands: the arrows match the
;;; dimensions already on the sheet without anyone having to remember what the
;;; scale is, and they rescale correctly the moment DIMSCALE changes.
;;;
;;; The head is formed by a polyline segment that starts at full width and
;;; tapers to nothing, which is what gives the solid triangular point. The tail
;;; that follows is drawn at zero width, so it reads as a thin leader line.
;;;
;;; COMMANDS
;;;   BARB       - standard arrow, head one third of DIMASZ wide
;;;   FATBARB    - heavy arrow, head a full DIMASZ wide. For when the arrow
;;;                needs to carry across a busy drawing.
;;;   CURVEBARB  - standard head, but the tail is a spline rather than straight
;;;                segments. Useful for curving a note around existing geometry.
;;;
;;; All three prompt continuously for further points, so one command draws a
;;; multi-segment leader. Press Enter to finish.
;;; ---------------------------------------------------------------------------

;; ---------------------------------------------------------------------------
;; Barb:HeadLength
;; ---------------------------------------------------------------------------
;; Returns the arrowhead length for the current drawing.
;;
;; DIMASZ is the arrowhead size at 1:1; DIMSCALE is the overall dimension
;; scale factor. Their product is the plotted size in drawing units.
;;
;; A guard is applied because both variables can legitimately be zero: DIMASZ
;; is zero in drawings that use tick marks instead of arrowheads, and DIMSCALE
;; is zero when annotative scaling is in charge. Either would produce a
;; zero-length, invisible arrow, so a sane fallback based on text height is
;; substituted instead.
;; ---------------------------------------------------------------------------
(defun Barb:HeadLength ( / size )
    (setq size (* (getvar "DIMSCALE") (getvar "DIMASZ")))
    (if (< size 1e-8)
        (max (getvar "TEXTSIZE") 1.0)
        size
    )
)

;; ---------------------------------------------------------------------------
;; Barb:Restore
;; ---------------------------------------------------------------------------
;; Shared cleanup. The system variable names and their captured values are
;; passed in rather than held at file scope, so the three commands can never
;; overwrite one another's saved state.
;; ---------------------------------------------------------------------------
(defun Barb:Restore ( vars vals )
    ;; If we arrive here mid-command - which the error handler can - close the
    ;; open PLINE or SPLINE first, or the undo group cannot be ended cleanly.
    (if (< 0 (getvar "CMDACTIVE"))
        (command)
    )
    (mapcar 'setvar vars vals)
    (if (= 8 (logand 8 (getvar "UNDOCTL")))
        (command "_.UNDO" "_End")
        (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
    )
    (princ)
)

;; ---------------------------------------------------------------------------
;; Barb:GetStart
;; ---------------------------------------------------------------------------
;; Prompts for the two points that define the arrowhead: the point the arrow
;; indicates, and the direction it comes from.
;;
;; Returns (pt1 pt2), or nil if the user cancelled either prompt. The original
;; version tested neither, and fed a nil straight into (angle p1 p2), which
;; raised a bad argument type error the moment anyone pressed Escape.
;; ---------------------------------------------------------------------------
(defun Barb:GetStart ( / pt1 pt2 )
    (if (and (setq pt1 (getpoint "\nPick arrow point (the end that touches the subject): "))
             (setq pt2 (getpoint pt1 "\nNext point: "))
        )
        (list pt1 pt2)
    )
)

;; ---------------------------------------------------------------------------
;; Barb:Tail
;; ---------------------------------------------------------------------------
;; Runs the "keep asking for points" loop shared by all three commands.
;;
;; The point supplied is fed to the open command first, then the user is asked
;; for another relative to it, until they press Enter.
;; ---------------------------------------------------------------------------
(defun Barb:Tail ( pt )
    (while pt
        (command pt)
        (setq pt (getpoint pt "\nNext point <finish>: "))
    )
    (princ)
)

;; ---------------------------------------------------------------------------
;; Barb:Draw
;; ---------------------------------------------------------------------------
;; Draws a straight-tailed arrow. Used by both BARB and FATBARB; the only
;; difference between them is the head width passed in.
;;
;; The PLINE sequence reads:
;;   pt1                  start at the arrow point
;;   "_w" 0 width         set width: zero at the tip, full width at the far end
;;   <tip of head>        draw the tapered head segment
;;   "_w" 0 0             drop back to zero width for the tail
;;
;; Because the width tapers from 0 up to width across that first segment, the
;; result is a solid triangle with its point at pt1 - a proper arrowhead rather
;; than a wedge pointing the wrong way.
;;
;; pt1, pt2 - [list] arrow point and direction point
;; width    - [real] width of the head at its widest
;; ---------------------------------------------------------------------------
(defun Barb:Draw ( pt1 pt2 width / size )
    (setq size (Barb:HeadLength))
    (command "_.PLINE" pt1
             "_w" 0 width
             (polar pt1 (angle pt1 pt2) size)
             "_w" 0 0
    )
    (Barb:Tail pt2)
    (command "")
    (princ)
)

;; ---------------------------------------------------------------------------
;; c:BARB  -  standard arrow
;; ---------------------------------------------------------------------------
(defun c:BARB ( / *error* vars vals pts )

    ;; OSMODE is forced off while the arrow is built, so running snaps cannot
    ;; drag the computed head vertex onto nearby geometry and deform the point.
    (setq vars '("CMDECHO" "OSMODE")
          vals (mapcar 'getvar vars)
    )

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

    (if (setq pts (Barb:GetStart))
        (progn
            (setvar "OSMODE" 0)
            ;; A third of the head length gives the classic slim arrowhead.
            (Barb:Draw (car pts) (cadr pts) (/ (Barb:HeadLength) 3.0))
        )
        (princ "\n*Cancelled* - two points are required.")
    )

    (Barb:Restore vars vals)
    (princ)
)

;; ---------------------------------------------------------------------------
;; c:FATBARB  -  heavy arrow
;; ---------------------------------------------------------------------------
(defun c:FATBARB ( / *error* vars vals pts )

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

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

    (if (setq pts (Barb:GetStart))
        (progn
            (setvar "OSMODE" 0)
            ;; Full head length as the width gives a squat, heavy head.
            (Barb:Draw (car pts) (cadr pts) (Barb:HeadLength))
        )
        (princ "\n*Cancelled* - two points are required.")
    )

    (Barb:Restore vars vals)
    (princ)
)

;; ---------------------------------------------------------------------------
;; c:CURVEBARB  -  arrow with a spline tail
;; ---------------------------------------------------------------------------
;; The head and the tail are two separate objects here: a short polyline for
;; the arrowhead, then a SPLINE that starts at the same two points and carries
;; on wherever the user leads it.
;;
;; The trailing (command "" "" "") supplies the three Enters that SPLINE wants
;; on the way out - one to end the point list, then two to accept the default
;; start and end tangents.
;; ---------------------------------------------------------------------------
(defun c:CURVEBARB ( / *error* vars vals pts pt1 pt2 tip )

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

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

    (if (setq pts (Barb:GetStart))
        (progn
            (setvar "OSMODE" 0)
            (setq pt1 (car pts)
                  pt2 (cadr pts)
                  tip (polar pt1 (angle pt1 pt2) (Barb:HeadLength))
            )

            ;; Head first, as its own closed polyline.
            (command "_.PLINE" pt1
                     "_w" 0 (/ (Barb:HeadLength) 3.0)
                     tip
                     "_w" 0 0
                     ""
            )

            ;; Then the spline tail, beginning where the head ended.
            (command "_.SPLINE" pt1 tip)
            (Barb:Tail pt2)
            (command "" "" "")
        )
        (princ "\n*Cancelled* - two points are required.")
    )

    (Barb:Restore vars vals)
    (princ)
)

(princ)