;;; ---------------------------------------------------------------------------
;;; SheetFill.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Fills title block attributes from a CSV, matching on drawing name.
;;;
;;; Keep one spreadsheet listing every drawing in the job and what its title
;;; block should say. Run this and the current drawing finds its own row and
;;; updates itself. Run it on every drawing and the whole set is consistent
;;; with the register - which is the only way a drawing list and a set of
;;; sheets ever stay in step.
;;;
;;; THE CSV FORMAT
;;; The first row is headings; every heading after the fixed columns is an
;;; ATTRIBUTE TAG. Each subsequent row is one drawing.
;;;
;;;     DWG       Layout    TITLE           REV   DATE
;;;     A-101     Sheet 1   GROUND FLOOR    C     2026-08-01
;;;     A-101     Sheet 2   FIRST FLOOR     C     2026-08-01
;;;     A-102     Sheet 1   SECTIONS        B     2026-07-22
;;;
;;; Column one is the drawing name, with or without its extension. The optional
;;; Layout and Block Name columns follow it - two rows for one drawing, as
;;; above, let each layout carry different information.
;;;
;;; CONFIGURATION - see the settings block below
;;;   SheetFill:CsvPath      fixed CSV location, or nil to be prompted
;;;   SheetFill:BlockFilter  restrict to particular blocks, e.g. "*BORDER"
;;;   SheetFill:HasLayout    T if the CSV has a Layout column
;;;   SheetFill:HasBlockName T if the CSV has a Block Name column
;;;   SheetFill:AutoRun      T to update automatically when a drawing opens
;;;
;;; WITHOUT A BLOCK FILTER THIS UPDATES EVERY ATTRIBUTED BLOCK whose tags match
;;; a CSV heading - not only title blocks. If your drawings use a tag like
;;; "REV" on other blocks too, set SheetFill:BlockFilter.
;;;
;;; RUNNING IT AUTOMATICALLY
;;; Load this from acaddoc.lsp with SheetFill:AutoRun set to T and every drawing
;;; updates itself as it opens. Note that autorun only happens when a fixed CSV
;;; path is configured - otherwise opening any drawing would pop a file dialog,
;;; which is why the original's unconditional autorun has been made conditional
;;; here.
;;;
;;;   SHEETFILL  - update attributes from the CSV
;;; ---------------------------------------------------------------------------

(vl-load-com)

;;; ---------------------------------------------------------------------------
;;; SETTINGS
;;; ---------------------------------------------------------------------------

;; CSV location. nil prompts for a file. A bare filename is searched for in the
;; drawing's own folder first, then along the support file search path.
(setq SheetFill:CsvPath nil)        ; e.g. "C:/Projects/1234/drawing-register.csv"

;; Restrict updating to blocks matching this pattern. nil updates every
;; attributed block - see the warning in the header.
(setq SheetFill:BlockFilter nil)    ; e.g. "*BORDER"

;; Does the CSV carry a Layout column immediately after the drawing name?
(setq SheetFill:HasLayout t)

;; Does it carry a Block Name column?
(setq SheetFill:HasBlockName nil)

;; Update automatically when this file loads. Only acts when a CsvPath is set.
(setq SheetFill:AutoRun nil)

;; ---------------------------------------------------------------------------
;; SheetFill:Doc  -  cached active document
;; ---------------------------------------------------------------------------
(defun SheetFill:Doc nil
    (eval (list 'defun 'SheetFill:Doc 'nil
                (vla-get-activedocument (vlax-get-acad-object))
          )
    )
    (SheetFill:Doc)
)

;; ---------------------------------------------------------------------------
;; SheetFill:BaseName
;; ---------------------------------------------------------------------------
;; Strips a drawing extension if present, leaving anything else alone.
;;
;; This is what lets the CSV list drawings either as "A-101" or as "A-101.dwg"
;; and match either way. The extension test is explicit rather than just taking
;; everything before the last dot, because drawing names legitimately contain
;; dots - "A-101.2" would otherwise be truncated to "A-101", which is the bug
;; version 1.7 of the original was released to fix.
;; ---------------------------------------------------------------------------
(defun SheetFill:BaseName ( s )
    (if (wcmatch (strcase s t) "*.dwg,*.dxf,*.dwt,*.dws")
        (vl-filename-base s)
        s
    )
)

;; ---------------------------------------------------------------------------
;; SheetFill:EffectiveName
;; ---------------------------------------------------------------------------
;; Returns a block reference's real name.
;;
;; A dynamic block altered from its default state is stored under an anonymous
;; name beginning with "*". 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.
;;
;; Without this, a dynamic title block would never match a block name filter.
;; ---------------------------------------------------------------------------
(defun SheetFill: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
)

;; ---------------------------------------------------------------------------
;; SheetFill:UnquoteCsv
;; ---------------------------------------------------------------------------
;; Converts doubled quotes back to single ones - the CSV escaping convention
;; for a quote inside a quoted field.
;; ---------------------------------------------------------------------------
(defun SheetFill:UnquoteCsv ( str / pos )
    (setq pos 0)
    (while (setq pos (vl-string-search "\"\"" str pos))
        (setq str (vl-string-subst "\"" "\"\"" str pos)
              pos (1+ pos)
        )
    )
    str
)

;; ---------------------------------------------------------------------------
;; SheetFill:SplitCsvLine
;; ---------------------------------------------------------------------------
;; Splits one CSV line into its cell values.
;;
;; This is more involved than splitting on the separator, because a QUOTED
;; field may itself contain separators - a title of "GROUND FLOOR, EAST WING"
;; is one cell, not two.
;;
;; The four cases:
;;   1. No separator left - the remainder is the final cell, unquoted if it was
;;      wrapped in quotes.
;;   2. The separator falls INSIDE a quoted field - recognised by the field so
;;      far having an odd number of quotes - so it is skipped and the search
;;      continues past it.
;;   3. The cell is quoted - strip the wrapping quotes and unescape it.
;;   4. An ordinary unquoted cell.
;;
;; str - [str] the line
;; sep - [str] separator
;; pos - [int] search start; always 0 from the caller
;; ---------------------------------------------------------------------------
(defun SheetFill:SplitCsvLine ( str sep pos / s )
    (cond
        (   (not (setq pos (vl-string-search sep str pos)))
            (if (wcmatch str "\"*\"")
                (list (SheetFill:UnquoteCsv (substr str 2 (- (strlen str) 2))))
                (list str)
            )
        )
        (   (or (wcmatch (setq s (substr str 1 pos)) "\"*[~\"]")
                (and (wcmatch s "~*[~\"]*") (= 1 (logand 1 pos)))
            )
            (SheetFill:SplitCsvLine str sep (+ pos 2))
        )
        (   (wcmatch s "\"*\"")
            (cons (SheetFill:UnquoteCsv (substr str 2 (- pos 2)))
                  (SheetFill:SplitCsvLine (substr str (+ pos 2)) sep 0)
            )
        )
        (   (cons s (SheetFill:SplitCsvLine (substr str (+ pos 2)) sep 0)))
    )
)

;; ---------------------------------------------------------------------------
;; SheetFill:ReadCsv
;; ---------------------------------------------------------------------------
;; Reads a CSV into a matrix of cell values.
;;
;; The separator is taken from the Windows regional settings rather than
;; assumed to be a comma - much of Europe uses a semicolon, and files exported
;; there would otherwise parse as a single column. This is also why files from
;; OpenOffice used to fail, which version 1.3 of the original addressed.
;;
;; The file handle is closed on every path.
;; ---------------------------------------------------------------------------
(defun SheetFill:ReadCsv ( csv / des lst sep str )
    (if (setq des (open csv "r"))
        (progn
            (setq sep
                (cond
                    ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList"))
                    (",")
                )
            )
            (while (setq str (read-line des))
                (setq lst (cons (SheetFill:SplitCsvLine str sep 0) lst))
            )
            (close des)
        )
    )
    (reverse lst)
)

;; ---------------------------------------------------------------------------
;; SheetFill:AllAssoc
;; ---------------------------------------------------------------------------
;; Returns EVERY association of a key, not just the first.
;;
;; Necessary because one drawing can legitimately appear on several CSV rows -
;; one per layout - and assoc alone would find only the first.
;; ---------------------------------------------------------------------------
(defun SheetFill:AllAssoc ( key lst / item )
    (if (setq item (assoc key lst))
        (cons (cdr item) (SheetFill:AllAssoc key (cdr (member item lst))))
    )
)

;; ---------------------------------------------------------------------------
;; SheetFill:RemoveFirst
;; ---------------------------------------------------------------------------
;; Removes only the FIRST occurrence of an item from a list.
;;
;; This is what supports DUPLICATE attribute tags. A title block can carry the
;; same tag more than once - a revision letter shown in two places, say - and
;; the CSV then holds a value per occurrence. Consuming one value per attribute
;; means the second occurrence takes the second value rather than both taking
;; the first.
;;
;; The technique: the comparison function starts as equal, and rewrites itself
;; to a function that always returns nil the moment it matches - so no later
;; item can match.
;; ---------------------------------------------------------------------------
(defun SheetFill:RemoveFirst ( itm lst / f )
    (setq f equal)
    (vl-remove-if
        (function (lambda ( a ) (if (f a itm) (setq f (lambda ( a b ) nil)))))
        lst
    )
)

;; ---------------------------------------------------------------------------
;; c:SHEETFILL  -  main routine
;; ---------------------------------------------------------------------------
(defun c:SHEETFILL ( / *error* vars vals csv ent lst sel str tag val
                       blockname flag attcount blockcount inc )

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

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

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

    (setvar "CMDECHO" 0)
    (setq csv SheetFill:CsvPath)

    (cond
        ;; -------------------------------------------------------------------
        ;; Gather the attributed blocks. (66 . 1) restricts to blocks that
        ;; actually carry attributes. The "`*U*" added to the filter includes
        ;; anonymous block names, so modified dynamic blocks are not missed -
        ;; their real names are checked individually further down.
        ;; -------------------------------------------------------------------
        (   (not (setq sel
                     (ssget "_X"
                         (vl-list* '(0 . "INSERT") '(66 . 1)
                             (if SheetFill:BlockFilter
                                 (list (cons 2 (strcat "`*U*," SheetFill:BlockFilter)))
                             )
                         )
                     )
                 )
            )
            (princ "\nNo attributed blocks found in this drawing.")
        )

        (   (and csv (not (setq csv (findfile csv))))
            (princ (strcat "\n" SheetFill:CsvPath " was not found."))
        )

        (   (and csv (/= ".CSV" (strcase (vl-filename-extension csv))))
            (princ "\nThe attribute data file must be a CSV.")
        )

        ;; getfiled flag 16 requires the file to exist.
        (   (not (or csv (setq csv (getfiled "Select CSV drawing register" "" "csv" 16))))
            (princ "\n*Cancelled*")
        )

        ;; Read it, upper-casing the first column so matching is case-insensitive.
        (   (not (setq lst
                     (mapcar (function (lambda ( x ) (cons (strcase (SheetFill:BaseName (car x))) (cdr x))))
                             (SheetFill:ReadCsv csv)
                     )
                 )
            )
            (princ (strcat "\nNo data found in " (vl-filename-base csv) ".csv"))
        )

        ;; Take the headings as the tag list, then reduce the rows to those for
        ;; THIS drawing.
        (   (not (setq tag (mapcar 'strcase (cdar lst))
                       lst (SheetFill:AllAssoc (strcase (SheetFill:BaseName (getvar 'dwgname))) lst)
                 )
            )
            (princ (strcat "\n\"" (SheetFill:BaseName (getvar 'dwgname))
                           "\" was not found in the first column of the CSV."
                   )
            )
        )

        (   t
            ;; Pair each value with its heading, giving ((TAG . value) ...) per row.
            (setq lst        (mapcar (function (lambda ( x ) (mapcar 'cons tag x))) lst)
                  attcount   0
                  blockcount 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")

            (repeat (setq inc (sslength sel))
                (setq ent       (ssname sel (setq inc (1- inc)))
                      blockname (strcase (SheetFill:EffectiveName ent))
                      val       lst
                      flag      nil
                )

                ;; The filter is re-tested against the EFFECTIVE name here,
                ;; which is what makes it work for dynamic blocks that were
                ;; admitted by the anonymous-name clause above.
                (if (or (null SheetFill:BlockFilter)
                        (wcmatch blockname (strcase SheetFill:BlockFilter))
                    )
                    (progn
                        ;; Narrow to this layout, if the CSV has that column.
                        ;; Each narrowing step drops the column it consumed, so
                        ;; the remaining pairs line up with the tag headings.
                        (if SheetFill:HasLayout
                            (setq val (mapcar (function (lambda ( x ) (cons (strcase (cdar x)) (cdr x)))) val)
                                  val (SheetFill:AllAssoc (strcase (cdr (assoc 410 (entget ent)))) val)
                            )
                        )

                        ;; Narrow to this block name, if that column exists;
                        ;; otherwise take the first remaining row.
                        (if SheetFill:HasBlockName
                            (setq val (mapcar (function (lambda ( x ) (cons (strcase (cdar x)) (cdr x)))) val)
                                  val (cdr (assoc blockname val))
                            )
                            (setq val (car val))
                        )

                        (if val
                            (foreach att (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
                                (if (and (setq str (assoc (strcase (vla-get-tagstring att)) val))
                                         (progn
                                             ;; Consume this value so a repeated
                                             ;; tag takes the next one.
                                             (setq val (SheetFill:RemoveFirst str val))
                                             ;; Only write when it differs, so an
                                             ;; already-correct drawing is not
                                             ;; needlessly modified.
                                             (/= (vla-get-textstring att) (cdr str))
                                         )
                                    )
                                    (progn
                                        (vla-put-textstring att (cdr str))
                                        (setq flag     t
                                              attcount (1+ attcount)
                                        )
                                    )
                                )
                            )
                        )
                        (if flag (setq blockcount (1+ blockcount)))
                    )
                )
            )

            (if (zerop attcount)
                (princ "\nAll attributes are already up to date.")
                (princ (strcat "\n" (itoa attcount)
                               " attribute" (if (= 1 attcount) "" "s")
                               " updated in " (itoa blockcount)
                               " block" (if (= 1 blockcount) "" "s") "."
                       )
                )
            )
        )
    )

    (SheetFill:Restore)
    (princ)
)

;; ---------------------------------------------------------------------------
;; AUTORUN
;; ---------------------------------------------------------------------------
;; Only runs when autorun is enabled AND a fixed CSV path is configured.
;;
;; The original ran unconditionally on load, which meant that loading it from
;; acaddoc.lsp without a configured path popped a file dialog on every single
;; drawing you opened. Requiring the path makes the automatic behaviour
;; deliberate rather than accidental.
;; ---------------------------------------------------------------------------
(if (and SheetFill:AutoRun SheetFill:CsvPath)
    (c:SHEETFILL)
)

(princ)