;;; ---------------------------------------------------------------------------
;;; DeepCount.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Counts blocks, reporting PRIMARY and NESTED quantities separately.
;;;
;;; An ordinary block count tells you how many block references sit in the
;;; drawing. That is not the same as how many of a component you actually have:
;;; if a WORKSTATION block contains four CHAIR blocks and you have inserted ten
;;; workstations, you have ten primary blocks and forty chairs. Anyone ordering
;;; from the first figure is ordering thirty-six chairs short.
;;;
;;; This counts both, at any depth of nesting and with any number of instances
;;; at each level, and reports them under separate headings.
;;;
;;; The report prints to the text window and can be written to a TXT or CSV
;;; file, which is opened automatically once written.
;;;
;;; TWO SUBTLETIES IT GETS RIGHT
;;;
;;;   Dynamic blocks are counted under their REAL name. A dynamic block that
;;;   has been modified is stored under an anonymous name like "*U27"; the
;;;   effective name is recovered from its representation tag so the count
;;;   reads sensibly rather than listing dozens of *U entries.
;;;
;;;   Hidden nested blocks are not counted. A block marked invisible by DXF
;;;   group 60 inside a definition is not present in the drawing as far as the
;;;   user is concerned, and counting it would inflate the schedule.
;;;
;;; HOW THE NESTED COUNT IS COMPUTED
;;; A map is built once of which blocks contain which, and how many of each.
;;; Each primary block then walks that map, multiplying as it descends - so a
;;; block appearing three times inside a block that appears four times inside
;;; the one you inserted contributes twelve.
;;;
;;;   DEEPCOUNT  - count blocks including nested instances
;;; ---------------------------------------------------------------------------

(vl-load-com)

;; Width of the printed report, in characters.
(setq DeepCount:Width 70)

;; ---------------------------------------------------------------------------
;; DeepCount:Add
;; ---------------------------------------------------------------------------
;; Adds a value to a key's running total in an association list, creating the
;; entry if it is not already there.
;; ---------------------------------------------------------------------------
(defun DeepCount:Add ( key value lst / pair )
    (if (setq pair (assoc key lst))
        (subst (cons key (+ value (cdr pair))) pair lst)
        (cons  (cons key value) lst)
    )
)

;; ---------------------------------------------------------------------------
;; DeepCount:PadBetween
;; ---------------------------------------------------------------------------
;; Joins two strings with enough repetitions of a padding character to reach a
;; total width - producing the dot leaders that make a column of counts
;; readable.
;; ---------------------------------------------------------------------------
(defun DeepCount:PadBetween ( s1 s2 ch ln )
    (   (lambda ( pad left right )
            (repeat (- ln (length left) (length right))
                (setq right (cons pad right))
            )
            (vl-list->string (append left right))
        )
        (ascii ch)
        (vl-string->list s1)
        (vl-string->list s2)
    )
)

;; ---------------------------------------------------------------------------
;; DeepCount:Contents
;; ---------------------------------------------------------------------------
;; Returns what one block definition contains, as ((blockName . quantity) ...).
;;
;; The definition's sub-entities are walked with entnext; each INSERT found is
;; another block nested inside. Entities flagged invisible by DXF group 60 are
;; skipped - see the header.
;; ---------------------------------------------------------------------------
(defun DeepCount:Contents ( blk / alist enx )
    (while (setq blk (entnext blk))
        (if (and (= "INSERT" (cdr (assoc 0 (setq enx (entget blk)))))
                 (/= 1 (cdr (assoc 60 enx)))
            )
            (setq alist (DeepCount:Add (cdr (assoc 2 enx)) 1 alist))
        )
    )
    alist
)

;; ---------------------------------------------------------------------------
;; DeepCount:Tree
;; ---------------------------------------------------------------------------
;; Returns a map of the whole drawing's block structure:
;;
;;     ((containerName (nestedName . qty) (nestedName . qty) ...) ...)
;;
;; Built once and reused for every primary block, because walking every
;; definition in a large drawing is expensive and the answer does not change.
;; ---------------------------------------------------------------------------
(defun DeepCount:Tree ( / block name tree )
    (while (setq block (tblnext "block" (null block)))
        (setq tree
            (cons (cons (setq name (cdr (assoc 2 block)))
                        (DeepCount:Contents (tblobjname "block" name))
                  )
                  tree
            )
        )
    )
    tree
)

;; ---------------------------------------------------------------------------
;; DeepCount:EffectiveName
;; ---------------------------------------------------------------------------
;; Returns the name a block reference should be counted under.
;;
;; Anonymous names begin with "*" - a dynamic block altered from its default
;; state is stored that way. The real name is recovered by following the block
;; definition's owner to its "AcDbBlockRepBTag" extended data, whose group 1005
;; holds a handle pointing at the original definition.
;;
;; The wildcard "`**" matches a literal asterisk followed by anything - the
;; backtick escapes the first asterisk so it is matched rather than treated as
;; a wildcard itself.
;; ---------------------------------------------------------------------------
(defun DeepCount:EffectiveName ( ent / blk rep )
    (if (wcmatch (setq blk (cdr (assoc 2 (entget ent)))) "`**")
        (if (and (setq rep
                     (cdadr
                         (assoc -3
                             (entget
                                 (cdr (assoc 330 (entget (tblobjname "block" blk))))
                                '("AcDbBlockRepBTag")
                             )
                         )
                     )
                 )
                 (setq rep (handent (cdr (assoc 1005 rep))))
            )
            (setq blk (cdr (assoc 2 (entget rep))))
        )
    )
    blk
)

;; ---------------------------------------------------------------------------
;; DeepCount:CountNested
;; ---------------------------------------------------------------------------
;; Accumulates the nested block counts contributed by one block.
;;
;; Recursive, multiplying as it descends: the quantity carried in is the number
;; of instances of the containing block, so a nested block appearing three
;; times within a container present four times contributes twelve, and its own
;; contents are then counted at that multiplied quantity in turn.
;;
;; name  - [str] block name to descend into
;; count - [int] how many instances of it exist at this point
;; tree  - [list] the structure map from DeepCount:Tree
;; alist - [list] accumulated counts so far
;; ---------------------------------------------------------------------------
(defun DeepCount:CountNested ( name count tree alist / nests )
    (if (setq nests (cdr (assoc name tree)))
        (foreach nest nests
            (setq alist
                (DeepCount:CountNested (car nest) (* count (cdr nest)) tree
                    (DeepCount:Add
                        (DeepCount:EffectiveName (tblobjname "block" (car nest)))
                        (* count (cdr nest))
                        alist
                    )
                )
            )
        )
        alist
    )
)

;; ---------------------------------------------------------------------------
;; DeepCount:Tally
;; ---------------------------------------------------------------------------
;; Returns (primaryCounts nestedCounts) for a selection.
;; ---------------------------------------------------------------------------
(defun DeepCount:Tally ( sel / tree block idx primary nested )
    (setq tree (DeepCount:Tree))
    (if sel
        (repeat (setq idx (sslength sel))
            (setq block   (ssname sel (setq idx (1- idx)))
                  primary (DeepCount:Add (DeepCount:EffectiveName block) 1 primary)
                  nested  (DeepCount:CountNested (cdr (assoc 2 (entget block))) 1 tree nested)
            )
        )
    )
    (list primary nested)
)

;; ---------------------------------------------------------------------------
;; DeepCount:Print
;; ---------------------------------------------------------------------------
;; Prints the report to the text window. The nested section is omitted entirely
;; when the drawing has no nested blocks, so a simple drawing gets a simple
;; report.
;; ---------------------------------------------------------------------------
(defun DeepCount:Print ( data / wid )
    (setq wid DeepCount:Width)

    (princ (DeepCount:PadBetween "\n" "" "=" wid))
    (princ "\n Block Count")
    (princ (DeepCount:PadBetween "\n" "" "=" wid))

    (princ
        (DeepCount:PadBetween
            (strcat "\n Primary Blocks (" (itoa (apply '+ (mapcar 'cdr (car data)))) ")")
            "Count" " " wid
        )
    )
    (princ (DeepCount:PadBetween "\n" "" "-" wid))
    (foreach item (vl-sort (car data) (function (lambda ( a b ) (< (car a) (car b)))))
        (princ (DeepCount:PadBetween (strcat "\n " (car item)) (itoa (cdr item)) "." wid))
    )

    (if (cadr data)
        (progn
            (princ (DeepCount:PadBetween "\n" "" "=" wid))
            (princ
                (DeepCount:PadBetween
                    (strcat "\n Nested Blocks (" (itoa (apply '+ (mapcar 'cdr (cadr data)))) ")")
                    "Count" " " wid
                )
            )
            (princ (DeepCount:PadBetween "\n" "" "-" wid))
            (foreach item (vl-sort (cadr data) (function (lambda ( a b ) (< (car a) (car b)))))
                (princ (DeepCount:PadBetween (strcat "\n " (car item)) (itoa (cdr item)) "." wid))
            )
        )
    )
    (princ (DeepCount:PadBetween "\n" "" "=" wid))
    (princ)
)

;; ---------------------------------------------------------------------------
;; DeepCount:Write
;; ---------------------------------------------------------------------------
;; Writes the report to a file. Tab-delimited for .txt so it lines up in a text
;; editor, comma-delimited otherwise so a spreadsheet parses it.
;;
;; The file handle is closed on every path - one left open stays locked for the
;; rest of the AutoCAD session.
;; ---------------------------------------------------------------------------
(defun DeepCount:Write ( data file / des del )
    (if file
        (if (setq des (open file "w"))
            (progn
                (setq del (if (= ".txt" (strcase (vl-filename-extension file) t)) "\t" ","))

                (princ "Block Count" des)
                (princ (strcat "\nPrimary Blocks ("
                               (itoa (apply '+ (mapcar 'cdr (car data))))
                               ")" del "Count")
                       des
                )
                (foreach item (vl-sort (car data) (function (lambda ( a b ) (< (car a) (car b)))))
                    (princ (strcat "\n" (car item) del (itoa (cdr item))) des)
                )

                (if (cadr data)
                    (progn
                        (princ (strcat "\n\nNested Blocks ("
                                       (itoa (apply '+ (mapcar 'cdr (cadr data))))
                                       ")" del "Count")
                               des
                        )
                        (foreach item (vl-sort (cadr data) (function (lambda ( a b ) (< (car a) (car b)))))
                            (princ (strcat "\n" (car item) del (itoa (cdr item))) des)
                        )
                    )
                )

                (close des)
                (startapp "explorer" file)
                (princ (strcat "\nReport written to " file))
            )
            (princ "\nUnable to write to the selected file.")
        )
        (princ "\n*Cancelled* - no output file chosen.")
    )
    (princ)
)

;; ---------------------------------------------------------------------------
;; c:DEEPCOUNT  -  main routine
;; ---------------------------------------------------------------------------
(defun c:DEEPCOUNT ( / *error* vars vals allblocks sel data out )

    ;; Read-only: nothing in the drawing is modified, so no undo group is
    ;; needed. NOMUTT is captured because the selection prompt suppresses it.
    (setq vars '("CMDECHO" "NOMUTT")
          vals (mapcar 'getvar vars)
    )

    (defun DeepCount:Restore ( )
        ;; Restored to the CAPTURED value; the original reset NOMUTT to a
        ;; hard-coded 0, which would clobber a non-default setting.
        (mapcar 'setvar vars vals)
        (princ)
    )

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

    (setvar "CMDECHO" 0)

    (cond
        ;; Gather everything first - this is the default when the user simply
        ;; presses Enter at the selection prompt.
        (   (null (setq allblocks (ssget "_X" '((0 . "INSERT")))))
            (princ "\nNo blocks found in this drawing.")
        )

        (   (progn
                (princ "\nSelect blocks to count <all>: ")
                (setvar 'nomutt 1)
                (setq sel
                    (cond
                        ((null (setq sel (vl-catch-all-apply 'ssget '(((0 . "INSERT")))))) allblocks)
                        ((null (vl-catch-all-error-p sel)) sel)
                    )
                )
                (setvar 'nomutt (cadr vals))
                sel
            )
            (setq data (DeepCount:Tally sel))
            (DeepCount:Print data)
            (textpage)

            (initget "TXT CSV")
            (if (setq out (getkword "\nOutput results to [TXT/CSV] <exit>: "))
                (DeepCount:Write data
                    (getfiled "Create Output File" "" (strcase out t) 1)
                )
            )
            (graphscr)
        )
    )

    (DeepCount:Restore)
    (princ)
)

(princ)