;;; ---------------------------------------------------------------------------
;;; TapeMeasure.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Totals the length of every selected curve and reports the result at the
;;; command line.
;;;
;;; Handles lines, arcs, circles, ellipses, splines and polylines - including
;;; polylines with bulged (arc) segments, whose true length along the arc is
;;; measured rather than the straight-line distance between vertices.
;;;
;;; HOW THE LENGTH IS OBTAINED
;;; Every curve in AutoCAD is internally parameterised: it runs from a start
;;; parameter to an end parameter, and the distance at any parameter can be
;;; queried directly. Asking for the distance at the END parameter therefore
;;; returns the entire length of the curve, correctly following every arc and
;;; spline curvature along the way.
;;;
;;; This replaces the approach the original used, which ran the AREA command
;;; once per object and read the PERIMETER system variable back afterwards.
;;; That was slow on large selections, disturbed the active command state, and
;;; returned nothing meaningful for open splines. Querying the curve directly
;;; is exact for every supported type and touches no command state at all.
;;;
;;; The result is formatted with rtos, so it honours the drawing's own LUNITS
;;; and LUPREC settings and reads in the same units as everything else.
;;;
;;;   TAPE  - total the length of a selection
;;; ---------------------------------------------------------------------------

;; The vlax-curve- functions are part of the ActiveX layer, which a fresh
;; drawing session may not have loaded yet.
(vl-load-com)

;; ---------------------------------------------------------------------------
;; TapeMeasure:Length
;; ---------------------------------------------------------------------------
;; Returns the length of one curve, or 0.0 if it cannot be measured.
;;
;; The measurement is wrapped in vl-catch-all-apply because a degenerate object
;; will throw rather than politely return zero - a zero-radius circle, a spline
;; whose control points coincide, or a polyline consisting of a single vertex
;; are all things that turn up in real drawings and would otherwise abort the
;; whole count part way through. Catching here means one bad object costs you
;; that object, not the entire total.
;;
;; ent - [ename] the entity to measure
;; ---------------------------------------------------------------------------
(defun TapeMeasure:Length ( ent / result )
    (setq result
        (vl-catch-all-apply
            (function
                (lambda ( )
                    (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))
                )
            )
        )
    )
    (if (vl-catch-all-error-p result)
        0.0
        result
    )
)

;; ---------------------------------------------------------------------------
;; c:TAPE  -  main routine
;; ---------------------------------------------------------------------------
(defun c:TAPE ( / *error* vars vals sel idx ent len total skipped count )

    ;; CMDECHO is silenced so the count runs without filling the command
    ;; history. Captured first so it can be put back exactly as found.
    (setq vars '("CMDECHO")
          vals (mapcar 'getvar vars)
    )

    ;; This routine only reads the drawing - it creates and modifies nothing -
    ;; so there is no undo group to open or close, and the restore does only
    ;; what its name says.
    (defun TapeMeasure:Restore ( )
        (mapcar 'setvar vars vals)
        (princ)
    )

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

    (setvar "CMDECHO" 0)

    ;; -----------------------------------------------------------------------
    ;; The selection is filtered to measurable curve types at the point of
    ;; picking. Doing it here rather than testing afterwards means objects that
    ;; have no length simply cannot be selected, which is far clearer than
    ;; quietly scoring them zero and leaving the user to wonder why the total
    ;; looks low - which is what the original did.
    ;;
    ;; "*POLYLINE" catches POLYLINE, LWPOLYLINE and 3DPOLYLINE alike.
    ;; -----------------------------------------------------------------------
    (princ "\nSelect objects to measure: ")
    (if (setq sel (ssget '((0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE"))))
        (progn
            (setq idx     0
                  total   0.0
                  skipped 0
                  count   (sslength sel)
            )

            ;; Walk the selection, accumulating length. A zero result means the
            ;; object was degenerate and got caught above, so it is counted
            ;; separately and reported rather than silently ignored.
            (while (setq ent (ssname sel idx))
                (setq len (TapeMeasure:Length ent))
                (if (zerop len)
                    (setq skipped (1+ skipped))
                    (setq total (+ total len))
                )
                (setq idx (1+ idx))
            )

            (princ
                (strcat "\nTotal length of " (itoa count)
                        " object" (if (= 1 count) "" "s") ": "
                        (rtos total)
                )
            )

            ;; Only mentioned when it actually happened, so a clean run stays
            ;; clean, but a suspect total always carries its explanation.
            (if (< 0 skipped)
                (princ
                    (strcat "  (" (itoa skipped)
                            " object" (if (= 1 skipped) " was" "s were")
                            " degenerate and could not be measured)"
                    )
                )
            )
        )
        (princ "\nNothing selected.")
    )

    (TapeMeasure:Restore)
    (princ)
)

(princ)