;;; ---------------------------------------------------------------------------
;;; RiseRun.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Differential X,Y dimensioning.
;;;
;;; Places a single aligned dimension between two picked points, but overrides
;;; the measured text with the horizontal and vertical components of the run:
;;;
;;;     X: +1250
;;;     Y:  -300
;;;
;;; Signed values are used deliberately - the sign tells you the direction of
;;; travel from the first point to the second, which is what makes this useful
;;; for setting out. Values are formatted to the current DIMDEC precision so
;;; they match the rest of the drawing's dimensions.
;;;
;;; COMMAND:  RISERUN  - dimension the X and Y difference between two points
;;; ---------------------------------------------------------------------------

;; ---------------------------------------------------------------------------
;; RiseRun:Delta
;; ---------------------------------------------------------------------------
;; Returns the signed difference (b - a) as a string, formatted to the current
;; dimension precision and carrying an explicit "+" when positive. AutoCAD's
;; rtos already supplies "-" for negatives, so only the positive case needs a
;; sign prepended.
;;
;; a, b - real numbers (a single ordinate of each pick point)
;; ---------------------------------------------------------------------------
(defun RiseRun:Delta ( a b / diff text )
    (setq diff (- b a)
          text (rtos diff 2 (getvar "DIMDEC"))
    )
    (if (< 0.0 diff)
        (strcat "+" text)
        text
    )
)

;; ---------------------------------------------------------------------------
;; c:RISERUN  -  main routine
;; ---------------------------------------------------------------------------
(defun c:RISERUN ( / *error* vars vals pt1 pt2 dx dy )

    ;; -----------------------------------------------------------------------
    ;; Capture every system variable this routine modifies, so both the normal
    ;; exit and the error path can put them back exactly as they were found.
    ;; -----------------------------------------------------------------------
    (setq vars '("CMDECHO")
          vals (mapcar 'getvar vars)
    )

    ;; -----------------------------------------------------------------------
    ;; Restore drawing state and close the undo group. Written so it is safe to
    ;; call more than once: the undo group is only ended if UNDOCTL reports one
    ;; is actually open (bit 8), which prevents a stray "UNDO End" from eating
    ;; the user's previous command.
    ;; -----------------------------------------------------------------------
    (defun RiseRun:Restore ( )
        (mapcar 'setvar vars vals)
        (if (= 8 (logand 8 (getvar "UNDOCTL")))
            (command "_.UNDO" "_End")
            (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
        )
        (princ)
    )

    ;; -----------------------------------------------------------------------
    ;; Local error handler. Swallows the routine cancel/escape messages, which
    ;; are normal user behaviour and not worth reporting, but surfaces anything
    ;; genuinely unexpected.
    ;; -----------------------------------------------------------------------
    (defun *error* ( msg )
        (RiseRun:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** RISERUN 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")

    ;; -----------------------------------------------------------------------
    ;; Collect both points before drawing anything. Each getpoint is checked -
    ;; the original version passed a nil point straight into the dimension
    ;; command if the user pressed Escape, which threw a raw LISP error.
    ;;
    ;; The second point is rubber-banded from the first so the user gets the
    ;; usual visual feedback while picking.
    ;; -----------------------------------------------------------------------
    (if (and (setq pt1 (getpoint "\nFirst dimension point: "))
             (setq pt2 (getpoint pt1 "\nSecond dimension point: "))
        )
        (progn
            ;; Component deltas, formatted and signed.
            (setq dx (RiseRun:Delta (car  pt1) (car  pt2))
                  dy (RiseRun:Delta (cadr pt1) (cadr pt2))
            )

            ;; "_non" defeats any running object snap so the dimension lands on
            ;; the coordinates actually picked. "\\P" is the MText paragraph
            ;; break that stacks the Y value beneath the X value.
            (command "_.dimaligned"
                     "_non" pt1
                     "_non" pt2
                     "_t"   (strcat "X: " dx "\\PY: " dy)
                     pause
            )
        )
        (princ "\n*Cancelled* - two points are required.")
    )

    (RiseRun:Restore)
    (princ)
)

(princ)