;;; ---------------------------------------------------------------------------
;;; QuickTally.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Totals length or area across a selection and prints the result.
;;;
;;;   TALLYLEN   - total length of selected curves
;;;   TALLYAREA  - total area of selected closed objects
;;;
;;; Both results are formatted with rtos, so they honour the drawing's LUNITS
;;; and LUPREC settings and read in the same units and precision as the rest of
;;; the drawing.
;;;
;;; TALLYAREA reports the area each object encloses. Note that an open polyline
;;; still has a computable area - AutoCAD treats it as though a closing segment
;;; ran from its last vertex back to its first - so if a boundary was never
;;; properly closed, the figure returned will be the area of that implied
;;; closure rather than an error. Worth knowing before trusting a total.
;;;
;;; These commands only read the drawing. Nothing is created or modified, so
;;; neither opens an undo group and neither alters any system variable.
;;; ---------------------------------------------------------------------------

;; vlax-curve- functions come from the ActiveX layer, which is not loaded into
;; a fresh session by default.
(vl-load-com)

;;; ---------------------------------------------------------------------------
;;; SELECTION FILTERS
;;;
;;; Both filters exclude 3D polylines and polygon meshes. Reading the exclusion
;;; from the inside out:
;;;
;;;     (0 . "POLYLINE") (-4 . "&") (70 . 80)
;;;
;;; "&" is a bitwise-AND test against DXF group 70, the polyline flags word.
;;; The value 80 is bits 16 and 64 together - 16 marks a 3D polygon mesh and 64
;;; marks a polyface mesh. Wrapping that pair in <NOT> therefore rejects meshes
;;; while still accepting ordinary 2D polylines.
;;;
;;; This matters because a mesh has no single planar area and no meaningful
;;; end-to-end length, so including one would silently corrupt the total.
;;; ---------------------------------------------------------------------------

;; Length filter - every curve type that has a measurable run.
(setq QuickTally:LenFilter
   '(   (0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE")
        (-4 . "<NOT")
            (-4 . "<AND")
                (0 . "POLYLINE") (-4 . "&") (70 . 80)
            (-4 . "AND>")
        (-4 . "NOT>")
    )
)

;; Area filter - LINE and ARC are absent, since neither encloses anything.
(setq QuickTally:AreaFilter
   '(   (0 . "CIRCLE,ELLIPSE,*POLYLINE,SPLINE")
        (-4 . "<NOT")
            (-4 . "<AND")
                (0 . "POLYLINE") (-4 . "&") (70 . 80)
            (-4 . "AND>")
        (-4 . "NOT>")
    )
)

;; ---------------------------------------------------------------------------
;; QuickTally:Sum
;; ---------------------------------------------------------------------------
;; Applies fn to every entity in a selection set and returns the running total.
;;
;; Each call is wrapped in vl-catch-all-apply so that one degenerate object -
;; a zero-radius circle, a single-vertex polyline, a spline with coincident
;; control points - costs only itself rather than aborting the entire tally
;; part way through and leaving the user with a misleadingly small number.
;;
;; The count of objects that failed is returned alongside the total, as a
;; dotted pair (total . skipped), so the caller can be honest about it.
;;
;; sel - [pickset] the selection to walk
;; fn  - [sym/lambda] function taking one entity name and returning a real
;; ---------------------------------------------------------------------------
(defun QuickTally:Sum ( sel fn / idx ent total skipped result )
    (setq idx     0
          total   0.0
          skipped 0
    )
    (while (setq ent (ssname sel idx))
        (setq result (vl-catch-all-apply fn (list ent)))
        (if (vl-catch-all-error-p result)
            (setq skipped (1+ skipped))
            (setq total (+ total result))
        )
        (setq idx (1+ idx))
    )
    (cons total skipped)
)

;; ---------------------------------------------------------------------------
;; QuickTally:Report
;; ---------------------------------------------------------------------------
;; Formats and prints the outcome of a tally.
;;
;; label  - [str] what is being totalled, e.g. "length"
;; count  - [int] how many objects were selected
;; result - [cons] the (total . skipped) pair from QuickTally:Sum
;; prec   - [int] rtos mode: nil for linear units, 2 for plain decimal
;; ---------------------------------------------------------------------------
(defun QuickTally:Report ( label count result prec )
    (princ
        (strcat "\nTotal " label " of " (itoa count)
                " object" (if (= 1 count) "" "s") ": "
                (if prec (rtos (car result) prec) (rtos (car result)))
        )
    )
    ;; Mentioned only when it actually happened, so a clean run reads cleanly
    ;; but a suspect total always arrives with its caveat attached.
    (if (< 0 (cdr result))
        (princ
            (strcat "  (" (itoa (cdr result))
                    " object" (if (= 1 (cdr result)) " was" "s were")
                    " degenerate and could not be measured)"
            )
        )
    )
    (princ)
)

;; ---------------------------------------------------------------------------
;; c:TALLYLEN  -  total the length of selected curves
;; ---------------------------------------------------------------------------
(defun c:TALLYLEN ( / *error* sel )

    ;; Read-only routine: no system variables changed, no undo group opened,
    ;; so the handler has nothing to restore and exists only to report cleanly.
    (defun *error* ( msg )
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** TALLYLEN error: " msg " **"))
        )
        (princ)
    )

    (princ "\nSelect curves to total: ")
    (if (setq sel (ssget QuickTally:LenFilter))
        ;; Distance at the end parameter is the full length of the curve,
        ;; following every arc and spline curvature along the way.
        (QuickTally:Report "length" (sslength sel)
            (QuickTally:Sum sel
               '(lambda ( e ) (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
            )
            nil
        )
        (princ "\nNothing selected.")
    )

    (princ)
)

;; ---------------------------------------------------------------------------
;; c:TALLYAREA  -  total the area of selected closed objects
;; ---------------------------------------------------------------------------
(defun c:TALLYAREA ( / *error* sel )

    (defun *error* ( msg )
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** TALLYAREA error: " msg " **"))
        )
        (princ)
    )

    (princ "\nSelect closed objects to total: ")
    (if (setq sel (ssget QuickTally:AreaFilter))
        ;; rtos mode 2 forces plain decimal output. Areas are squared units, so
        ;; formatting them as architectural feet-and-inches - which is what
        ;; LUNITS would otherwise do - would be actively misleading.
        (QuickTally:Report "area" (sslength sel)
            (QuickTally:Sum sel 'vlax-curve-getarea)
            2
        )
        (princ "\nNothing selected.")
    )

    (princ)
)

(princ)