;;; ---------------------------------------------------------------------------
;;; SheetNumber.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Renumbers paper space layouts sequentially, with an optional prefix and
;;; suffix.
;;;
;;; Layouts are renumbered in TAB ORDER - the order they appear along the
;;; bottom of the screen - not alphabetically. So drag the tabs into the order
;;; you want the set issued in, then run this, and the numbering follows.
;;;
;;; You are asked for a prefix, a suffix and a starting number, then whether to
;;; renumber all layouts or choose specific ones from a filtered list.
;;;
;;; A prefix of "A-" with two-digit padding from 1 produces:
;;;     A-01, A-02, A-03 ...
;;;
;;; WHY IT RENAMES EVERYTHING TWICE
;;; Layout names must be unique, so renaming directly would collide as soon as
;;; a target name matched a layout not yet renumbered - renaming "Sheet 2" to
;;; "A-01" fails outright if an "A-01" already exists further along the set.
;;;
;;; To avoid that, every layout being renumbered is first given a temporary
;;; name built from a seed string, and only then given its final name. The seed
;;; is a run of "%" characters, lengthened until it appears in no existing
;;; layout name - so it cannot collide with anything real.
;;;
;;; When only SOME layouts are renumbered, the names of the untouched ones are
;;; also checked, and any number that would clash with them is skipped.
;;;
;;; PRESETTING THE PARAMETERS
;;; The four settings at the top of the code can be fixed rather than prompted -
;;; useful if your office always uses the same prefix. Set any of them to a
;;; value instead of nil and that prompt is skipped.
;;;
;;;   SHEETNUMBER  - renumber paper space layouts
;;; ---------------------------------------------------------------------------

(vl-load-com)

;;; ---------------------------------------------------------------------------
;;; SETTINGS - set to a value to fix it, or nil to be prompted each time.
;;; ---------------------------------------------------------------------------

(setq SheetNumber:Prefix nil)   ; e.g. "A-"  ("" for none, nil to prompt)
(setq SheetNumber:Suffix nil)   ; e.g. " Rev A"
(setq SheetNumber:Start  nil)   ; e.g. 1
(setq SheetNumber:Digits 2)     ; 1 = "1", 2 = "01", 3 = "001"

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

;; ---------------------------------------------------------------------------
;; SheetNumber:ValidString
;; ---------------------------------------------------------------------------
;; Prompts for a prefix or suffix, rejecting anything AutoCAD would not accept
;; in a layout name.
;;
;; snvalid performs the validation, so the rule matches AutoCAD's own exactly
;; rather than duplicating a character list that might drift out of date. An
;; empty response is allowed and means "none".
;; ---------------------------------------------------------------------------
(defun SheetNumber:ValidString ( msg / rtn )
    (while
        (not (or (= "" (setq rtn (getstring t msg)))
                 (snvalid (vl-string-trim " " rtn))
             )
        )
        (princ "\nA layout name cannot contain any of  \\ < > / ? \" : ; * | , =")
    )
    rtn
)

;; ---------------------------------------------------------------------------
;; SheetNumber:Pad
;; ---------------------------------------------------------------------------
;; Left-pads a string with zeros to the required length. A number already
;; longer than the padding is returned unchanged rather than truncated - better
;; an inconsistent width than a wrong sheet number.
;; ---------------------------------------------------------------------------
(defun SheetNumber:Pad ( str len )
    (if (< (strlen str) len)
        (SheetNumber:Pad (strcat "0" str) len)
        str
    )
)

;; ---------------------------------------------------------------------------
;; SheetNumber:FilterListBox
;; ---------------------------------------------------------------------------
;; Multi-select list with a filter box. Returns the chosen strings, or nil.
;;
;; The filter action is stored as a quoted expression converted to a string,
;; which is how a multi-statement action is attached to a tile. On each change
;; it rebuilds the list from matching entries and works out where the previous
;; selections have moved to, so the selection survives filtering.
;;
;; The dialog name "sheetnumber" must match between the DCL and new_dialog.
;; ---------------------------------------------------------------------------
(defun SheetNumber:FilterListBox ( msg lst mtp / SheetNumber:AddList dch dcl des rtn sel tmp flt )

    (defun SheetNumber:AddList ( key lst )
        (start_list key)
        (foreach x lst (add_list x))
        (end_list)
        lst
    )

    (if (and
            (setq dcl (vl-filename-mktemp nil nil ".dcl"))
            (setq des (open dcl "w"))
            (write-line
                (strcat
                    "sheetnumber : dialog { label = \"" msg "\"; spacer;"
                    ": list_box { key = \"lst\"; width = 50; fixed_width = true; height = 15; "
                    "fixed_height = true; allow_accept = true; "
                    "multiple_select = " (if mtp "true" "false") "; }"
                    ": edit_box { key = \"flt\"; width = 50; fixed_width = true; label = \"Filter:\"; }"
                    "spacer; ok_cancel; }"
                )
                des
            )
            (not (close des))
            (< 0 (setq dch (load_dialog dcl)))
            (new_dialog "sheetnumber" dch)
        )
        (progn
            (SheetNumber:AddList "lst" (setq tmp lst))
            (set_tile "lst" (setq rtn "0"))
            (set_tile "flt" "*")
            (action_tile "lst" "(setq rtn $value)")
            (action_tile "flt"
                (vl-prin1-to-string
                   '(progn
                        (setq flt (strcat "*" (strcase $value) "*")
                              sel (mapcar (function (lambda ( n ) (nth n tmp)))
                                          (read (strcat "(" rtn ")"))
                              )
                        )
                        (SheetNumber:AddList "lst"
                            (setq tmp (vl-remove-if-not
                                          (function (lambda ( x ) (wcmatch (strcase x) flt)))
                                          lst
                                      )
                            )
                        )
                        (set_tile "lst"
                            (setq rtn
                                (vl-string-trim "()"
                                    (vl-princ-to-string
                                        (cond
                                            ((vl-sort (vl-remove nil
                                                          (mapcar (function (lambda ( x ) (vl-position x tmp))) sel))
                                                     '<))
                                            ('(0))
                                        )
                                    )
                                )
                            )
                        )
                    )
                )
            )
            (setq rtn
                (if (= 1 (start_dialog))
                    (mapcar (function (lambda ( x ) (nth x tmp))) (read (strcat "(" rtn ")")))
                )
            )
        )
    )

    (if (and dch (< 0 dch)) (unload_dialog dch))
    (if (and (= 'str (type dcl)) (findfile dcl)) (vl-file-delete dcl))
    rtn
)

;; ---------------------------------------------------------------------------
;; c:SHEETNUMBER  -  main routine
;; ---------------------------------------------------------------------------
(defun c:SHEETNUMBER ( / *error* vars vals pre suf num pad layouts names order
                         chosen seed tmp new count )

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

    (defun SheetNumber: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 )
        (SheetNumber:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** SHEETNUMBER error: " msg " **"))
        )
        (princ)
    )

    (setvar "CMDECHO" 0)

    ;; Take each setting from the constants above, or prompt for it.
    (setq pre SheetNumber:Prefix
          suf SheetNumber:Suffix
          num SheetNumber:Start
          pad SheetNumber:Digits
    )
    (or (= 'str (type pre)) (setq pre (SheetNumber:ValidString "\nSpecify prefix <none>: ")))
    (or (= 'str (type suf)) (setq suf (SheetNumber:ValidString "\nSpecify suffix <none>: ")))
    (or (= 'int (type num)) (setq num (cond ((getint "\nSpecify starting number <1>: ")) (1))))
    (or (and (= 'int (type pad)) (<= 0 pad)) (setq pad 0))

    ;; Collect the layout objects, their names and their tab order together.
    (vlax-for lyt (vla-get-layouts (SheetNumber:Doc))
        (if (= :vlax-false (vla-get-modeltype lyt))
            (setq layouts (cons lyt layouts)
                  names   (cons (vla-get-name lyt) names)
                  order   (cons (vla-get-taborder lyt) order)
            )
        )
    )

    (initget "All Select")
    (cond
        ;; User chose Select but then cancelled the list.
        (   (and (= "Select" (getkword "\nRenumber all layouts or selected? [All/Select] <All>: "))
                 (null (setq chosen
                           (SheetNumber:FilterListBox "Select Layouts to Renumber"
                               (mapcar (function (lambda ( n ) (nth n names)))
                                       (vl-sort-i order '<)
                               )
                               t
                           )
                       )
                 )
            )
            (princ "\n*Cancelled*")
        )

        (   t
            ;; Reduce the working lists to the chosen layouts only.
            (if chosen
                (setq layouts (vl-remove nil (mapcar (function (lambda ( a b ) (if (member a chosen) b))) names layouts))
                      order   (vl-remove nil (mapcar (function (lambda ( a b ) (if (member a chosen) b))) names order))
                )
            )

            ;; ---------------------------------------------------------------
            ;; Build a seed that appears in no existing layout name, nor in the
            ;; prefix - lengthening it until that is true.
            ;; ---------------------------------------------------------------
            (setq names (cons (strcase pre) (mapcar 'strcase names))
                  seed  "%"
            )
            (while (vl-some (function (lambda ( x ) (wcmatch x (strcat "*" seed "*")))) names)
                (setq seed (strcat seed "%"))
            )

            ;; 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")

            ;; Pass one: temporary names, so no final name can collide with a
            ;; layout that has not been renamed yet.
            (setq tmp 0)
            (foreach lyt layouts
                (vla-put-name lyt (strcat seed (itoa (setq tmp (1+ tmp)))))
            )

            ;; Reduce the name list to layouts NOT being renumbered - those are
            ;; the ones whose names the new numbers must avoid.
            (if chosen
                (setq chosen (mapcar 'strcase chosen)
                      names  (vl-remove-if (function (lambda ( x ) (member x chosen))) names)
                )
                (setq names nil)
            )

            ;; Pass two: final names, assigned in tab order.
            (setq count 0)
            (foreach idx (vl-sort-i order '<)
                ;; Skip any number that would collide with an untouched layout.
                (while (member (strcase (setq new (strcat pre (SheetNumber:Pad (itoa num) pad) suf)))
                               names
                       )
                    (setq num (1+ num))
                )
                (vla-put-name (nth idx layouts) new)
                (setq num   (1+ num)
                      count (1+ count)
                )
            )

            (princ (strcat "\n" (itoa count)
                           " layout" (if (= 1 count) "" "s") " renumbered."
                   )
            )
        )
    )

    (SheetNumber:Restore)
    (princ)
)

(princ)