;;; ---------------------------------------------------------------------------
;;; CrossHair.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Draws a crossed pair of centrelines through an arc, circle or ellipse, at
;;; a length and rotation you drag out.
;;;
;;;   CROSSHAIR  - centre-mark a curved object
;;; ---------------------------------------------------------------------------

(defun c:CROSSHAIR ( / *error* vars vals ang dis ent pt1 pt2 )

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

    (defun CrossHair:Restore ( )
        (mapcar 'setvar vars vals)
        (if (= 8 (logand 8 (getvar "UNDOCTL")))
            (command "_.UNDO" "_End")
            (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
        )
        (princ)
    )

    (defun *error* ( msg )
        (CrossHair:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** CROSSHAIR 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
        (and
            ;; Re-prompt loop: errno 7 means the user clicked empty space, so
            ;; that is a retry rather than a cancel. Pressing Enter or Escape
            ;; leaves ent nil and falls out.
            (progn
                (while
                    (progn
                        (setvar 'errno 0)
                        (setq ent (car (entsel "\nSelect arc, circle or ellipse: ")))
                        (cond
                            ((= 7 (getvar 'errno))
                             (princ "\nMissed, try again.")
                            )
                            ((= 'ename (type ent))
                             (if (not (wcmatch (cdr (assoc 0 (entget ent))) "CIRCLE,ARC,ELLIPSE"))
                                 (princ "\nNot an arc, circle or ellipse - try again.")
                             )
                            )
                        )
                    )
                )
                (= 'ename (type ent))
            )
            ;; DXF 10 is the centre. Transformed from the object's own
            ;; coordinate system to the current UCS so it survives a rotated
            ;; UCS or a non-world extrusion.
            (setq pt1 (trans (cdr (assoc 10 (entget ent))) ent 1))
            (setq pt2 (getpoint pt1 "\nSpecify length and direction of centreline: "))
            (setq ang (angle pt1 pt2)
                  dis (distance pt1 pt2)
            )
        )
        ;; Two passes: draw a line through the centre, then rotate 90 degrees
        ;; and repeat. Negating dis each pass makes each line run symmetrically
        ;; either side of the centre.
        (repeat 2
            (entmake
                (list
                   '(0 . "LINE")
                    (cons 10 (trans (polar pt1 ang dis)     1 0))
                    (cons 11 (trans (polar pt1 ang (- dis)) 1 0))
                )
            )
            (setq ang (+ ang (/ pi 2.0))
                  dis (- dis)
            )
        )
        (princ "\n*Cancelled*")
    )

    (CrossHair:Restore)
    (princ)
)

(princ)