;;; ---------------------------------------------------------------------------
;;; SheetShuffle.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; REORDER, RENAME AND MANAGE LAYOUT TABS
;;;
;;; A single dialog listing every layout in the drawing, where they can be
;;; dragged into order, sorted, renamed, prefixed, suffixed, added, deleted,
;;; copied, and searched -- with everything applied at once when you close
;;; it.
;;;
;;; AutoCAD's own tab handling is one right-click menu per tab. On a drawing
;;; with thirty sheets that needs renumbering after a sheet is inserted in
;;; the middle, that is thirty right-clicks and thirty typed names, with no
;;; way to see the result until it is finished.
;;;
;;; ---------------------------------------------------------------------------
;;; WHAT IT DOES
;;;
;;;   MOVE       Top, Up, Down and Bottom move every highlighted tab at once,
;;;              keeping their relative order.
;;;
;;;   SORT       Three sorting methods:
;;;                Alphabetical  ordinary A to Z.
;;;                Numerical     by the numbers inside the names, so Sheet2
;;;                              comes before Sheet10 rather than after it.
;;;                Architectural by the parts of the name in turn, comparing
;;;                              numbers as numbers and text as text -- so
;;;                              A-101, A-102, A-201, S-101 comes out right.
;;;              Either direction.
;;;
;;;   REVERSE    Reverses just the highlighted tabs, leaving the rest where
;;;              they are.
;;;
;;;   PREF/SUFF  Adds text before and after tab names, either to the
;;;              highlighted ones or to all of them. Rejects any change that
;;;              would create two tabs with the same name.
;;;
;;;   ADD        Creates a new layout, named Layout1, Layout2 and so on --
;;;              always the next name not already in use.
;;;
;;;   DELETE     Removes the highlighted tabs, after confirming.
;;;
;;;   COPY       Duplicates the highlighted tabs, including all their
;;;              contents, naming each copy "Original (2)", "(3)" and so on.
;;;
;;;   CURRENT    Switches the drawing to the highlighted tab.
;;;
;;;   FIND       Find and replace across tab names, one at a time or all at
;;;              once, with each match shown in context.
;;;
;;;   RESET      Puts the names and order back to how they were when the
;;;              dialog opened -- but does not resurrect deleted tabs or
;;;              remove added ones.
;;;
;;; Double-click any tab in the list to rename it.
;;;
;;; ---------------------------------------------------------------------------
;;; HOW IT WORKS
;;;
;;; Renaming, adding, deleting and copying happen immediately, because those
;;; are what the user is watching for.
;;;
;;; REORDERING does not. The list in the dialog is just a list of names; only
;;; when the dialog closes is each layout's TabOrder property set from its
;;; position in that list. Reordering tabs one at a time would make AutoCAD
;;; renumber every other tab after each move, which is both slow and prone to
;;; leaving the tabs in a state nobody asked for.
;;;
;;; Every change is inside one undo group, so a whole session of shuffling
;;; undoes in one step.
;;;
;;; ---------------------------------------------------------------------------
;;; ABOUT THE SORTING
;;;
;;; The numerical and architectural sorts both work by splitting each name
;;; into alternating runs of text and numbers -- "A-101a" becomes
;;; ("A-" 101 "a") -- and then comparing those pieces in step.
;;;
;;; The numerical sort keeps only the numeric pieces, so it orders purely by
;;; the numbers found anywhere in the name. The architectural sort keeps
;;; everything and compares each piece against its counterpart, with numbers
;;; sorting before text when the two disagree in type. That is what makes it
;;; handle real sheet numbering schemes correctly.
;;;
;;; ---------------------------------------------------------------------------
;;; NOTES
;;;
;;; Tab names cannot contain  < > / \ " : ; ? * | , =  and the dialog rejects
;;; them, as AutoCAD would.
;;;
;;; Model space is deliberately not listed; it cannot be renamed, moved or
;;; deleted.
;;;
;;; ---------------------------------------------------------------------------
;;;   SHEETSHUFFLE - manage layout tabs
;;; ---------------------------------------------------------------------------

(vl-load-com)

;;; ---------------------------------------------------------------------------
;;; Remembered dialog settings. Global so they survive between runs.
;;;
;;;   *SheetShuffle:SortType*  "0" alphabetical, "1" numerical, "2" architectural
;;;   *SheetShuffle:SortOrder* "asc" or "des"
;;;   *SheetShuffle:AllTabs*   1 if prefix/suffix should apply to every tab
;;; ---------------------------------------------------------------------------

(or *SheetShuffle:SortType*  (setq *SheetShuffle:SortType*  "0"))
(or *SheetShuffle:SortOrder* (setq *SheetShuffle:SortOrder* "asc"))
(or *SheetShuffle:AllTabs*   (setq *SheetShuffle:AllTabs*    0))

;;; ---------------------------------------------------------------------------
;;; Characters AutoCAD forbids in a layout name, as a wildcard pattern. The
;;; backquotes escape the characters wcmatch would otherwise treat as
;;; wildcards of its own.
;;; ---------------------------------------------------------------------------

(setq *SheetShuffle:Illegal* "*[<>\\/\\\":;`?`*|`,=]*")

;;; ---------------------------------------------------------------------------
;;; SHEETSHUFFLE
;;; ---------------------------------------------------------------------------

(defun c:SheetShuffle

    ( /
        ;; ---- nested helper functions ----
        *error* SS:Restore SS:FillList SS:ToList SS:ToValue SS:GetLayouts
        SS:Rename SS:Sort SS:Delete SS:PrefixSuffix SS:AddTab SS:CopyTab
        SS:FindReplace SS:Help SS:Duplicates

        ;; ---- local variables ----
        acdoc aclay layouts dch dcl des idx names newres num old ptr reset
        tmp vals vars
    )

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

    ;;; -----------------------------------------------------------------------
    ;;; SS:Restore
    ;;; -----------------------------------------------------------------------

    (defun SS:Restore ( )
        (if (= 'file (type des)) (close des))
        (if (and (= 'int (type dch)) (< 0 dch)) (unload_dialog dch))
        (if (and (= 'str (type dcl)) (findfile dcl)) (vl-file-delete dcl))
        (while (= 8 (logand 8 (getvar 'undoctl)))
            (vla-endundomark acdoc)
        )
        (mapcar 'setvar vars vals)
        (princ)
    )

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

    ;;; -----------------------------------------------------------------------
    ;;; Small utilities.
    ;;; -----------------------------------------------------------------------

    ;; Loads a list box tile.
    (defun SS:FillList ( key lst )
        (start_list key)
        (foreach x lst (add_list x))
        (end_list)
        lst
    )

    ;; A multi-select list box reports its highlighted rows as a
    ;; space-separated string of indices. Wrapping that in brackets and
    ;; reading it turns it into a LISP list in one step, and printing a list
    ;; and trimming the brackets converts back.
    (defun SS:ToList  ( val ) (read (strcat "(" val ")")))
    (defun SS:ToValue ( lst ) (vl-string-trim "()" (vl-princ-to-string lst)))

    ;;; -----------------------------------------------------------------------
    ;;; SS:GetLayouts
    ;;;
    ;;; Returns every layout object except Model, in the order the tabs
    ;;; currently appear.
    ;;;
    ;;; The Layouts collection is in creation order, not tab order, so it is
    ;;; sorted by the TabOrder property -- which is what the user actually
    ;;; sees along the bottom of the screen.
    ;;; -----------------------------------------------------------------------

    (defun SS:GetLayouts ( / lst )
        (vlax-for lay aclay
            (if (/= "MODEL" (strcase (vla-get-name lay)))
                (setq lst (cons lay lst))
            )
        )
        (vl-sort lst '(lambda ( a b ) (< (vla-get-taborder a) (vla-get-taborder b))))
    )

    ;;; -----------------------------------------------------------------------
    ;;; SS:Duplicates
    ;;;
    ;;; Returns the values that appear more than once in a list. Used to check
    ;;; that a Reset would not produce two tabs with the same name.
    ;;; -----------------------------------------------------------------------

    (defun SS:Duplicates ( lst )
        (if lst
            (if (vl-position (car lst) (cdr lst))
                (cons (car lst) (SS:Duplicates (vl-remove (car lst) (cdr lst))))
                (SS:Duplicates (vl-remove (car lst) (cdr lst)))
            )
        )
    )

    ;;; -----------------------------------------------------------------------
    ;;; SS:Rename
    ;;;
    ;;; The rename sub-dialog, opened by double-clicking a tab.
    ;;;
    ;;; Three things are checked before the name is accepted: it must not be
    ;;; empty, it must not contain a character AutoCAD forbids, and it must
    ;;; not duplicate another tab. The tab being renamed is excluded from that
    ;;; last test, so renaming a tab to itself is allowed.
    ;;;
    ;;;   handle - the loaded dialog handle
    ;;;   n      - index of the tab to rename
    ;;;   lst    - the current list of names
    ;;;
    ;;; Returns the list, updated if the rename succeeded.
    ;;; -----------------------------------------------------------------------

    (defun SS:Rename ( handle n lst / name others )

        ;; Every name except the one being renamed.
        (setq others (mapcar 'strcase (SS:RemoveNth n lst)))

        (if (not (new_dialog "rename" handle))
            (progn (princ "\nUnable to open the rename dialog.") lst)
            (progn
                (set_tile  "name" (setq name (nth n lst)))
                ;; Mode 2 selects the text so typing replaces it.
                (mode_tile "name" 2)
                (action_tile "name" "(setq name $value)")

                (action_tile "accept"
                    (vl-prin1-to-string
                       '(progn
                            (set_tile "error" "")
                            (cond
                                (   (= "" name)
                                    (set_tile "error" "Please enter a tab name.")
                                )
                                (   (wcmatch (strcase name) *SheetShuffle:Illegal*)
                                    (set_tile "error" "That name contains an illegal character.")
                                    (mode_tile "name" 2)
                                )
                                (   (vl-position (strcase name) others)
                                    (set_tile "error" (strcat name " already exists."))
                                    (mode_tile "name" 2)
                                )
                                (   (done_dialog 1))
                            )
                        )
                    )
                )

                (if (= 1 (start_dialog))
                    (cond
                        ;;  Unchanged.
                        (   (= name (nth n lst)) lst)
                        ;;  The rename can still fail -- another session may
                        ;;  have taken the name -- so it is caught.
                        (   (vl-catch-all-error-p
                                (vl-catch-all-apply 'vla-put-name
                                    (list (vla-item aclay (nth n lst)) name))
                            )
                            (alert "That tab could not be renamed.")
                            lst
                        )
                        (   (subst name (nth n lst) lst))
                    )
                    lst
                )
            )
        )
    )

    ;;; -----------------------------------------------------------------------
    ;;; SS:Sort
    ;;;
    ;;; The sort sub-dialog. Returns the list in the chosen order, or
    ;;; unchanged if cancelled.
    ;;; -----------------------------------------------------------------------

    (defun SS:Sort ( handle lst )
        (if (not (new_dialog "sort" handle))
            (progn (princ "\nUnable to open the sort dialog.") lst)
            (progn
                (SS:FillList "typ" '("Alphabetical" "Numerical" "Architectural"))
                (set_tile "typ" *SheetShuffle:SortType*)
                (set_tile *SheetShuffle:SortOrder* "1")

                (action_tile "typ" "(setq *SheetShuffle:SortType*  $value)")
                (action_tile "asc" "(setq *SheetShuffle:SortOrder* $key)")
                (action_tile "des" "(setq *SheetShuffle:SortOrder* $key)")

                (if (zerop (start_dialog))
                    lst
                    (progn
                        (cond
                            (   (= "0" *SheetShuffle:SortType*) (setq lst (acad_strlsort lst)))
                            (   (= "1" *SheetShuffle:SortType*) (setq lst (SS:NumSort  lst)))
                            (   (= "2" *SheetShuffle:SortType*) (setq lst (SS:ArchSort lst)))
                        )
                        (if (= "asc" *SheetShuffle:SortOrder*) lst (reverse lst))
                    )
                )
            )
        )
    )

    ;;; -----------------------------------------------------------------------
    ;;; SS:Delete
    ;;;
    ;;; Deletes the highlighted tabs after confirming.
    ;;;
    ;;; Deletion is not undoable in the ordinary sense -- the layout and
    ;;; everything on it goes -- so the warning is deliberate.
    ;;;
    ;;; The whole delete loop is caught as one: AutoCAD refuses to delete the
    ;;; last remaining layout, and rather than trying to predict that, the
    ;;; failure is handled and the list left alone.
    ;;; -----------------------------------------------------------------------

    (defun SS:Delete ( handle idx lst / ok )
        (if (not (new_dialog "delwarn" handle))
            (progn (princ "\nUnable to open the confirmation dialog.") lst)
            (progn
                (action_tile "accept" "(setq ok t) (done_dialog)")
                (start_dialog)
                (if ok
                    (if (vl-catch-all-error-p
                            (vl-catch-all-apply
                               '(lambda nil
                                    (foreach n idx (vla-delete (vla-item aclay (nth n lst))))
                                )
                            )
                        )
                        (progn
                            (alert "Those tabs could not be deleted.")
                            lst
                        )
                        (SS:RemoveItems idx lst)
                    )
                    lst
                )
            )
        )
    )

    ;;; -----------------------------------------------------------------------
    ;;; SS:PrefixSuffix
    ;;;
    ;;; Adds text before and after tab names, to the highlighted tabs or to
    ;;; all of them.
    ;;;
    ;;; The duplicate check only applies in "highlighted only" mode: applying
    ;;; the same prefix to EVERY tab cannot create a duplicate, because every
    ;;; name changes by the same amount.
    ;;; -----------------------------------------------------------------------

    (defun SS:PrefixSuffix ( handle idx lst / n pref suff untouched )

        (if (not (new_dialog "prefsuff" handle))
            (progn (princ "\nUnable to open the prefix/suffix dialog.") lst)
            (progn
                (set_tile "all" (itoa *SheetShuffle:AllTabs*))

                (action_tile "accept"
                    (vl-prin1-to-string
                       '(cond
                            (   (and (/= "" (setq pref (get_tile "pref")))
                                     (wcmatch (strcase pref) *SheetShuffle:Illegal*))
                                (set_tile "error" "The prefix contains an illegal character.")
                                (mode_tile "pref" 2)
                            )
                            (   (and (/= "" (setq suff (get_tile "suff")))
                                     (wcmatch (strcase suff) *SheetShuffle:Illegal*))
                                (set_tile "error" "The suffix contains an illegal character.")
                                (mode_tile "suff" 2)
                            )
                            (   (and (zerop *SheetShuffle:AllTabs*)
                                     (setq untouched (mapcar 'strcase (SS:RemoveItems idx lst)))
                                     (vl-some
                                        '(lambda ( x )
                                             (vl-position (strcase (strcat pref x suff)) untouched)
                                         )
                                         (mapcar '(lambda ( n ) (nth n lst)) idx)
                                     )
                                )
                                (set_tile "error" "That change would create a duplicate tab name.")
                                (mode_tile "pref" 2)
                            )
                            (   (done_dialog 1))
                        )
                    )
                )
                (action_tile "all" "(setq *SheetShuffle:AllTabs* (atoi $value))")

                (if (/= 1 (start_dialog))
                    lst
                    (if (zerop *SheetShuffle:AllTabs*)
                        ;;  Highlighted tabs only.
                        (progn
                            (setq n -1)
                            (mapcar
                               '(lambda ( x )
                                    (if (member (setq n (1+ n)) idx)
                                        (progn
                                            (vla-put-name (vla-item aclay x) (strcat pref x suff))
                                            (strcat pref x suff)
                                        )
                                        x
                                    )
                                )
                                lst
                            )
                        )
                        ;;  Every tab.
                        (mapcar
                           '(lambda ( x )
                                (vla-put-name (vla-item aclay x) (strcat pref x suff))
                                (strcat pref x suff)
                            )
                            lst
                        )
                    )
                )
            )
        )
    )

    ;;; -----------------------------------------------------------------------
    ;;; SS:AddTab
    ;;;
    ;;; Adds a new layout named Layout1, Layout2 and so on -- whichever is the
    ;;; first not already in use. The comparison is case-insensitive because
    ;;; AutoCAD's own name check is.
    ;;; -----------------------------------------------------------------------

    (defun SS:AddTab ( lst / n name upper )
        (setq name  "Layout1"
              n     1
              upper (mapcar 'strcase lst)
        )
        (while (member (strcase name) upper)
            (setq name (strcat "Layout" (itoa (setq n (1+ n)))))
        )
        (vla-add aclay name)
        (append lst (list name))
    )

    ;;; -----------------------------------------------------------------------
    ;;; SS:CopyTab
    ;;;
    ;;; Duplicates the highlighted tabs, contents and all.
    ;;;
    ;;; Two separate operations are needed. CopyFrom duplicates the layout's
    ;;; own settings -- plot device, paper size, scale, plot area -- but not
    ;;; the geometry on it. CopyObjects then copies every entity in the source
    ;;; layout's block into the new layout's block.
    ;;;
    ;;; Copies are named "Original (2)", "(3)" and so on, skipping any number
    ;;; already taken.
    ;;; -----------------------------------------------------------------------

    (defun SS:CopyTab ( idx lst / mem n newblk newlay newname oldlay oldname upper )

        (setq upper (mapcar 'strcase lst))

        (foreach x idx
            (setq oldname (nth x lst)
                  oldlay  (vla-item aclay oldname)
                  newname (strcat oldname " (2)")
                  n       2
                  mem     nil
            )
            (while (member (strcase newname) upper)
                (setq newname (strcat oldname " (" (itoa (setq n (1+ n))) ")"))
            )
            (setq newlay (vla-add aclay newname)
                  newblk (vla-get-block newlay)
                  lst    (append lst (list newname))
                  upper  (append upper (list (strcase newname)))
            )
            ;; Layout settings first...
            (vla-copyfrom newlay oldlay)
            ;; ...then the geometry.
            (vlax-for obj (vla-get-block oldlay) (setq mem (cons obj mem)))
            (if mem
                (vla-copyobjects acdoc
                    (vlax-make-variant
                        (vlax-safearray-fill
                            (vlax-make-safearray vlax-vbobject (cons 0 (1- (length mem))))
                            (reverse mem)
                        )
                    )
                    newblk
                )
            )
        )
        lst
    )

    ;;; -----------------------------------------------------------------------
    ;;; SS:FindReplace
    ;;;
    ;;; The find and replace sub-dialog.
    ;;;
    ;;; Find builds a list of every occurrence in every tab name -- not just
    ;;; every matching tab -- so a name containing the search text twice is
    ;;; visited twice. Each hit is shown with the match bracketed in place, so
    ;;; the user can see exactly which occurrence is about to be replaced.
    ;;;
    ;;; After a replacement the remaining hits in that same tab have to be
    ;;; recalculated, because the name has changed length and their recorded
    ;;; positions are now wrong.
    ;;; -----------------------------------------------------------------------

    (defun SS:FindReplace ( handle lst / findstr flen found hit n newname pos repstr rlen tab )

        (if (not (new_dialog "find" handle))
            (progn (princ "\nUnable to open the find dialog.") lst)
            (progn
                (set_tile "ftxt" "")
                (set_tile "fstr" (setq findstr ""))
                (set_tile "rstr" (setq repstr  ""))

                ;; Changing the search text invalidates any hits already found.
                (action_tile "fstr"
                    "(set_tile \"ftxt\" \"\") (setq found nil findstr $value)")
                (action_tile "rstr" "(setq repstr $value)")

                ;;  ---- Find: step to the next occurrence ----
                (action_tile "fnd"
                    (vl-prin1-to-string
                       '(cond
                            ;;  More hits from a previous search: take the next.
                            (   found
                                (set_tile "ftxt" (caar found))
                                (setq tab   (cadar  found)
                                      pos   (caddar found)
                                      found (cdr    found)
                                )
                            )
                            (   (= "" findstr)
                                (set_tile "ftxt" "Enter something to find.")
                                (setq found nil tab nil pos nil)
                            )
                            (   t
                                ;; Build the complete list of hits: every
                                ;; occurrence in every name, in order.
                                (setq flen (strlen findstr)
                                      pos  0
                                      found nil
                                )
                                (foreach name lst
                                    (setq pos 0)
                                    (while (setq pos (vl-string-search (strcase findstr)
                                                                      (strcase name) pos))
                                        (setq found
                                            (cons
                                                (list
                                                    ;; The name with the match
                                                    ;; bracketed, for display.
                                                    (strcat (substr name 1 pos) "["
                                                            (substr name (1+ pos) flen) "]"
                                                            (substr name (+ pos flen 1)))
                                                    name
                                                    pos
                                                )
                                                found
                                            )
                                            pos (+ pos flen)
                                        )
                                    )
                                )
                                (setq found (reverse found))
                                (if found
                                    (progn
                                        (set_tile "ftxt" (caar found))
                                        (setq tab   (cadar  found)
                                              pos   (caddar found)
                                              found (cdr    found)
                                        )
                                    )
                                    (progn
                                        (set_tile "ftxt" "Not found.")
                                        (setq tab nil pos nil)
                                    )
                                )
                            )
                        )
                    )
                )

                ;;  ---- Replace: change the occurrence currently shown ----
                (action_tile "rep"
                    (vl-prin1-to-string
                       '(cond
                            (   (null tab)
                                (set_tile "ftxt" "Nothing found to replace - press Find first.")
                            )
                            (   (wcmatch repstr *SheetShuffle:Illegal*)
                                (set_tile "ftxt" "The replacement contains an illegal character.")
                            )
                            (   (member
                                    (vl-string-trim " "
                                        (strcase
                                            (setq newname
                                                (strcat (substr tab 1 pos) repstr
                                                        (substr tab (+ 1 pos flen))))
                                        )
                                    )
                                    (mapcar 'strcase lst)
                                )
                                (set_tile "ftxt" "That would create a duplicate tab name.")
                            )
                            (   t
                                (vla-put-name (vla-item aclay tab) newname)
                                (set_tile "ftxt" (strcat (get_tile "ftxt") "  ->  " newname))
                                (setq lst (subst newname tab lst))
                                ;; Every remaining hit in this same tab now
                                ;; refers to the old name at the old offsets,
                                ;; so they are recalculated against the new
                                ;; name.
                                (setq found
                                    (mapcar
                                       '(lambda ( x / at )
                                            (if (= tab (cadr x))
                                                (progn
                                                    (setq at (caddr x))
                                                    ;; Hits after the point of
                                                    ;; replacement shift by the
                                                    ;; change in length.
                                                    (if (< pos at)
                                                        (setq at (+ at (- (strlen repstr) flen)))
                                                    )
                                                    (setq at (vl-string-search (strcase findstr)
                                                                               (strcase newname) at))
                                                    (list
                                                        (strcat (substr newname 1 at) "["
                                                                (substr newname (1+ at) flen) "]"
                                                                (substr newname (+ at flen 1)))
                                                        newname
                                                        at
                                                    )
                                                )
                                                x
                                            )
                                        )
                                        found
                                    )
                                )
                                (setq tab newname)
                            )
                        )
                    )
                )

                ;;  ---- Replace All ----
                (action_tile "repa"
                    (vl-prin1-to-string
                       '(progn
                            (set_tile "ftxt" "")
                            (cond
                                (   (= "" findstr)
                                    (set_tile "ftxt" "Enter something to find.")
                                    (setq found nil)
                                )
                                (   (wcmatch repstr *SheetShuffle:Illegal*)
                                    (set_tile "ftxt" "The replacement contains an illegal character.")
                                )
                                (   t
                                    (setq n    0
                                          flen (strlen findstr)
                                          rlen (strlen repstr)
                                    )
                                    (foreach tab lst
                                        (setq hit     n
                                              pos     0
                                              newname tab
                                        )
                                        ;; Every occurrence in this one name.
                                        ;; The search resumes past the
                                        ;; replacement, so replacing "a" with
                                        ;; "aa" cannot loop forever.
                                        (while (setq pos (vl-string-search (strcase findstr)
                                                                           (strcase newname) pos))
                                            (setq newname (strcat (substr newname 1 pos) repstr
                                                                  (substr newname (+ 1 pos flen)))
                                                  pos     (+ pos rlen)
                                                  hit     (1+ hit)
                                            )
                                        )
                                        ;; Skip any rename that would collide.
                                        (if (not (member (strcase newname) (mapcar 'strcase lst)))
                                            (progn
                                                (vla-put-name (vla-item aclay tab) newname)
                                                (setq n   hit
                                                      lst (subst newname tab lst)
                                                )
                                            )
                                        )
                                    )
                                    (set_tile "ftxt"
                                        (if (< 0 n)
                                            (strcat (itoa n) " replacement"
                                                    (if (= 1 n) "" "s") " made.")
                                            "Not found."
                                        )
                                    )
                                    (setq found nil tab nil)
                                )
                            )
                        )
                    )
                )

                (start_dialog)
                lst
            )
        )
    )

    ;;; -----------------------------------------------------------------------
    ;;; SS:Help
    ;;; -----------------------------------------------------------------------

    (defun SS:Help ( handle )
        (if (not (new_dialog "help" handle))
            (princ "\nUnable to open the help dialog.")
            (start_dialog)
        )
        (princ)
    )

    ;;; =======================================================================
    ;;;                       M A I N   R O U T I N E
    ;;; =======================================================================

    (setvar 'cmdecho 0)

    (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
          aclay (vla-get-layouts acdoc)
    )

    ;; ---- build the dialog ---------------------------------------------------
    ;; Written to a uniquely named temporary file, loaded, and deleted on
    ;; exit, so two AutoCAD sessions cannot collide and nothing is left behind.

    (cond
        (   (not
                (and
                    (setq dcl (vl-filename-mktemp nil nil ".dcl"))
                    (setq des (open dcl "w"))
                    (progn
                        (foreach line
                           '(
                                "dcl_settings : default_dcl_settings { audit_level = 1; }"
                                ""
                                "// Shared tile shapes, so the button rows line up."
                                "button13 : button   { width = 13; alignment = centered; fixed_width = true; }"
                                "button16 : button   { width = 16; alignment = centered; fixed_width = true; }"
                                "eBox     : edit_box { alignment = centered; fixed_width = true;"
                                "                      allow_accept = true; is_tab_stop = true; }"
                                "fBox     : edit_box { alignment = left; fixed_width = true; is_tab_stop = true; }"
                                "ttl      : text     { alignment = centered; is_bold = true; fixed_width = false; }"
                                "txt      : text     { alignment = centered; fixed_width = false; }"
                                "ltxt     : text     { alignment = left;     fixed_width = false; }"
                                ""
                                "tabsort : dialog { label = \"Sheet Shuffle\";"
                                "  spacer;"
                                "  : row {"
                                "    : button13 { key = \"mtop\"; label = \"Top\";    mnemonic = \"T\"; }"
                                "    : button13 { key = \"up\";   label = \"Up\";     mnemonic = \"U\"; }"
                                "    : button13 { key = \"down\"; label = \"Down\";   mnemonic = \"D\"; }"
                                "    : button13 { key = \"mbot\"; label = \"Bottom\"; mnemonic = \"B\"; }"
                                "  }"
                                "  : list_box { key = \"tabs\"; width = 20; fixed_width = false;"
                                "               alignment = centered; multiple_select = true; }"
                                "  : row {"
                                "    : button13 { key = \"sort\"; label = \"Sort...\";   mnemonic = \"S\"; }"
                                "    : button13 { key = \"rev\";  label = \"Reverse\";   mnemonic = \"R\"; }"
                                "    : button13 { key = \"p_s\";  label = \"Pref/Suff\"; mnemonic = \"P\"; }"
                                "    : button13 { key = \"cur\";  label = \"Current\";   mnemonic = \"n\"; }"
                                "  }"
                                "  spacer;"
                                "  : row { fixed_width = false;"
                                "    : button13 { key = \"add\";  label = \"Add\";    mnemonic = \"A\"; }"
                                "    : button13 { key = \"del\";  label = \"Delete\"; mnemonic = \"e\"; }"
                                "    : button13 { key = \"copy\"; label = \"Copy\";   mnemonic = \"C\"; }"
                                "    : button13 { key = \"fnr\";  label = \"Find\";   mnemonic = \"F\"; }"
                                "  }"
                                "  : text { alignment = centered;"
                                "           label = \"Double-click a tab to rename it\"; }"
                                "  : row { fixed_width = true; alignment = centered;"
                                "    : button13 { key = \"accept\"; label = \"Done\";  mnemonic = \"o\";"
                                "                 is_default = true; is_cancel = true; }"
                                "    : button13 { key = \"res\";    label = \"Reset\"; mnemonic = \"s\"; }"
                                "    : button13 { key = \"help\";   label = \"Help\";  mnemonic = \"H\"; }"
                                "  }"
                                "}"
                                ""
                                "rename : dialog { label = \"Rename Tab\"; spacer;"
                                "  : eBox { key = \"name\"; edit_width = 20; edit_limit = 255;"
                                "           label = \"Tab Name:\"; }"
                                "  : errtile { }"
                                "  spacer; ok_cancel;"
                                "}"
                                ""
                                "delwarn : dialog { label = \"Warning\"; spacer;"
                                "  : text { alignment = centered;"
                                "           label = \"The selected tabs will be permanently deleted.\"; }"
                                "  : text { alignment = centered; label = \"Proceed?\"; }"
                                "  spacer; ok_cancel;"
                                "}"
                                ""
                                "prefsuff : dialog { label = \"Add Prefix / Suffix\"; spacer;"
                                "  : row {"
                                "    : column {"
                                "      : text { alignment = centered; label = \"Prefix\"; }"
                                "      : eBox { key = \"pref\"; edit_width = 15; edit_limit = 255; }"
                                "    }"
                                "    : column {"
                                "      : spacer { alignment = centered; width = 10; }"
                                "      : text   { alignment = centered; label = \"< Tab Name >\"; }"
                                "    }"
                                "    : column {"
                                "      : text { alignment = centered; label = \"Suffix\"; }"
                                "      : eBox { key = \"suff\"; edit_width = 15; edit_limit = 255; }"
                                "    }"
                                "  }"
                                "  spacer;"
                                "  : row { spacer;"
                                "    : toggle { key = \"all\"; label = \"Apply to all tabs\";"
                                "               mnemonic = \"A\"; alignment = right; is_tab_stop = true; }"
                                "  }"
                                "  : errtile { } ok_cancel;"
                                "}"
                                ""
                                "find : dialog { label = \"Find and Replace\"; spacer;"
                                "  : row {"
                                "    : column { fixed_height = true;"
                                "      : text { label = \"Find what:\"; }"
                                "      : fBox { key = \"fstr\"; edit_width = 30; mnemonic = \"W\"; }"
                                "      : text { label = \"Replace with:\"; }"
                                "      : fBox { key = \"rstr\"; edit_width = 30; mnemonic = \"R\"; }"
                                "    }"
                                "    : spacer { width = 4; }"
                                "    : column { fixed_height = true;"
                                "      : spacer   { height = 0.2; }"
                                "      : button16 { key = \"fnd\";  label = \"Find\";        mnemonic = \"F\"; }"
                                "      : button16 { key = \"rep\";  label = \"Replace\";     mnemonic = \"p\"; }"
                                "      : button16 { key = \"repa\"; label = \"Replace All\"; mnemonic = \"A\"; }"
                                "    }"
                                "  }"
                                "  spacer;"
                                "  : text { key = \"ftxt\"; alignment = left; label = \" \"; value = \"\"; }"
                                "  spacer;"
                                "  : button13 { key = \"accept\"; label = \"Done\"; mnemonic = \"o\";"
                                "               is_default = true; is_cancel = true; }"
                                "}"
                                ""
                                "sort : dialog { label = \"Sort\"; spacer;"
                                "  : boxed_column { label = \"Sort Type\";"
                                "    : popup_list { key = \"typ\"; alignment = centered; }"
                                "    spacer;"
                                "    : radio_row { children_alignment = centered;"
                                "      : radio_button { key = \"asc\"; label = \"Ascending\";  }"
                                "      : radio_button { key = \"des\"; label = \"Descending\"; }"
                                "    }"
                                "    spacer;"
                                "  }"
                                "  spacer;"
                                "  : row { fixed_width = false; alignment = centered;"
                                "    : button13 { key = \"accept\"; label = \"Sort\";   mnemonic = \"S\";"
                                "                 is_default = true; }"
                                "    : button13 { key = \"cancel\"; label = \"Cancel\"; mnemonic = \"C\";"
                                "                 is_cancel = true; }"
                                "  }"
                                "}"
                                ""
                                "help : dialog { label = \"Sheet Shuffle - Help\";"
                                "  spacer; : ttl { label = \"Program Controls\"; } spacer;"
                                "  : row { fixed_width = true; alignment = centered;"
                                "    : column {"
                                "      : txt { label = \"Top\";           }"
                                "      : txt { label = \"Up\";            }"
                                "      : txt { label = \"Down\";          }"
                                "      : txt { label = \"Bottom\";        }"
                                "      : txt { label = \"Sort\";          }"
                                "      : txt { label = \"Alphabetical\";  }"
                                "      : txt { label = \"Numerical\";     }"
                                "      : txt { label = \"Architectural\"; }"
                                "      : txt { label = \"Reverse\";       }"
                                "      : txt { label = \"Pref/Suff\";     }"
                                "      : txt { label = \"Add\";           }"
                                "      : txt { label = \"Delete\";        }"
                                "      : txt { label = \"Copy\";          }"
                                "      : txt { label = \"Current\";       }"
                                "      : txt { label = \"Find\";          }"
                                "      : txt { label = \"Done\";          }"
                                "      : txt { label = \"Reset\";         }"
                                "    }"
                                "    : spacer { width = 3; }"
                                "    : column {"
                                "      : ltxt { label = \"Move the selected tabs to the top of the list.\"; }"
                                "      : ltxt { label = \"Move the selected tabs up one place.\"; }"
                                "      : ltxt { label = \"Move the selected tabs down one place.\"; }"
                                "      : ltxt { label = \"Move the selected tabs to the bottom.\"; }"
                                "      : ltxt { label = \"Opens the sort dialog.\"; }"
                                "      : ltxt { label = \"Sort the tabs A to Z.\"; }"
                                "      : ltxt { label = \"Sort by the numbers within the names.\"; }"
                                "      : ltxt { label = \"Sort by name parts, numbers as numbers.\"; }"
                                "      : ltxt { label = \"Reverse the order of the selected tabs.\"; }"
                                "      : ltxt { label = \"Add text before and after tab names.\"; }"
                                "      : ltxt { label = \"Add a new layout, next free name.\"; }"
                                "      : ltxt { label = \"Delete the selected tabs.\"; }"
                                "      : ltxt { label = \"Duplicate the selected tabs and contents.\"; }"
                                "      : ltxt { label = \"Switch to the selected tab.\"; }"
                                "      : ltxt { label = \"Find and replace within tab names.\"; }"
                                "      : ltxt { label = \"Apply the new order and close.\"; }"
                                "      : ltxt { label = \"Undo renames and reordering only.\"; }"
                                "    }"
                                "  }"
                                "  spacer_1; ok_only;"
                                "}"
                            )
                            (write-line line des)
                        )
                        (setq des (close des))
                        (< 0 (setq dch (load_dialog dcl)))
                    )
                    (new_dialog "tabsort" dch)
                )
            )
            (princ "\nUnable to create the dialog.")
        )

        (   t
            (vla-startundomark acdoc)

            ;; names is the working list; reset is a snapshot of how things
            ;; were when the dialog opened, for the Reset button.
            (setq names (mapcar 'vla-get-name (SS:GetLayouts))
                  reset names
            )
            (SS:FillList "tabs" names)

            ;; Start with the current tab highlighted, if a layout is active.
            (set_tile "tabs"
                (setq ptr
                    (if (zerop (getvar 'tilemode))
                        (itoa (cond ((vl-position (getvar 'ctab) names)) (0)))
                        "0"
                    )
                )
            )

            ;;; ---------------------------------------------------------------
            ;;; Callbacks.
            ;;;
            ;;; Written as quoted lists and converted with vl-prin1-to-string,
            ;;; which produces correct quoting every time where hand-escaped
            ;;; strings do not.
            ;;;
            ;;; Each move operation reapplies the highlight afterwards, so the
            ;;; tabs the user is working on stay selected and the buttons can
            ;;; be pressed repeatedly.
            ;;; ---------------------------------------------------------------

            ;;  $reason 4 is a double-click, which renames.
            (action_tile "tabs"
                (vl-prin1-to-string
                   '(progn
                        (setq ptr $value)
                        (if (= 4 $reason)
                            (progn
                                (SS:FillList "tabs"
                                    (setq names (SS:Rename dch (atoi ptr) names)))
                                (set_tile "tabs" ptr)
                            )
                        )
                    )
                )
            )

            ;;  Up and Down: the highlighted names are remembered, the list is
            ;;  rearranged, and the highlight is set from where those names
            ;;  now are.
            (action_tile "up"
                (vl-prin1-to-string
                   '(progn
                        (setq idx (SS:ToList ptr)
                              old (mapcar '(lambda ( n ) (nth n names)) idx)
                        )
                        (SS:FillList "tabs" (setq names (SS:ListUp idx names)))
                        (set_tile "tabs"
                            (setq ptr (SS:ToValue
                                          (mapcar '(lambda ( x ) (vl-position x names)) old)))
                        )
                    )
                )
            )
            (action_tile "down"
                (vl-prin1-to-string
                   '(progn
                        (setq idx (SS:ToList ptr)
                              old (mapcar '(lambda ( n ) (nth n names)) idx)
                        )
                        (SS:FillList "tabs" (setq names (SS:ListDown idx names)))
                        (set_tile "tabs"
                            (setq ptr (SS:ToValue
                                          (mapcar '(lambda ( x ) (vl-position x names)) old)))
                        )
                    )
                )
            )

            ;;  Top and Bottom: the moved tabs end up in a known contiguous
            ;;  block, so the new highlight is simply counted out.
            (action_tile "mtop"
                (vl-prin1-to-string
                   '(progn
                        (SS:FillList "tabs"
                            (setq names (SS:ListToTop (setq idx (SS:ToList ptr)) names)))
                        (setq num -1)
                        (set_tile "tabs"
                            (setq ptr (SS:ToValue
                                          (mapcar '(lambda ( x ) (setq num (1+ num))) idx)))
                        )
                    )
                )
            )
            (action_tile "mbot"
                (vl-prin1-to-string
                   '(progn
                        (SS:FillList "tabs"
                            (setq names (SS:ListToBottom (setq idx (SS:ToList ptr)) names)))
                        (setq num (length names))
                        (set_tile "tabs"
                            (setq ptr (SS:ToValue
                                          (reverse (mapcar '(lambda ( x ) (setq num (1- num))) idx))))
                        )
                    )
                )
            )

            (action_tile "sort"
                (vl-prin1-to-string
                   '(progn
                        (setq idx (SS:ToList ptr)
                              old (mapcar '(lambda ( n ) (nth n names)) idx)
                        )
                        (SS:FillList "tabs" (setq names (SS:Sort dch names)))
                        (set_tile "tabs"
                            (setq ptr (SS:ToValue
                                          (mapcar '(lambda ( x ) (vl-position x names)) old)))
                        )
                    )
                )
            )

            (action_tile "rev"
                (vl-prin1-to-string
                   '(progn
                        (SS:FillList "tabs"
                            (setq names (SS:ReverseItems (SS:ToList ptr) names)))
                        (set_tile "tabs" ptr)
                    )
                )
            )

            ;;  Delete: the reset list has to shrink too, or Reset would try
            ;;  to restore names for tabs that no longer exist. The entries
            ;;  are removed by their ORIGINAL tab positions.
            (action_tile "del"
                (vl-prin1-to-string
                   '(progn
                        (setq idx (SS:ToList ptr)
                              old (mapcar '(lambda ( n ) (nth n names)) idx)
                              tmp names
                        )
                        (setq newres
                            (SS:RemoveItems
                                (mapcar '(lambda ( x )
                                             (1- (vla-get-taborder (vla-item aclay x))))
                                        old)
                                reset
                            )
                        )
                        (SS:FillList "tabs"
                            (setq names
                                (cond
                                    (   (SS:Delete dch idx names))
                                    ;;  If the delete failed entirely, re-read
                                    ;;  the real state rather than trusting the
                                    ;;  list.
                                    (   (mapcar 'vla-get-name (SS:GetLayouts)))
                                )
                            )
                        )
                        (if (not (equal tmp names))
                            (setq reset (cond (newres) (names)))
                        )
                        (set_tile "tabs"
                            (setq ptr
                                (if (zerop (getvar 'tilemode))
                                    (itoa (cond ((vl-position (getvar 'ctab) names)) (0)))
                                    "0"
                                )
                            )
                        )
                    )
                )
            )

            (action_tile "p_s"
                (vl-prin1-to-string
                   '(progn
                        (SS:FillList "tabs"
                            (setq names (SS:PrefixSuffix dch (SS:ToList ptr) names)))
                        (set_tile "tabs" ptr)
                    )
                )
            )

            ;;  Reset: restore the original names and order. Refused if the
            ;;  original names would now collide with something added since.
            (action_tile "res"
                (vl-prin1-to-string
                   '(if (SS:Duplicates (mapcar 'strcase reset))
                        (alert "Resetting would create duplicate tab names.")
                        (progn
                            (SS:FillList "tabs" (setq names reset))
                            (mapcar 'vla-put-name (SS:GetLayouts) reset)
                            (set_tile "tabs"
                                (setq ptr
                                    (if (zerop (getvar 'tilemode))
                                        (itoa (cond ((vl-position (getvar 'ctab) names)) (0)))
                                        "0"
                                    )
                                )
                            )
                        )
                    )
                )
            )

            ;;  Add: the new tab goes on the end of both lists and is
            ;;  highlighted, ready to be renamed.
            (action_tile "add"
                (vl-prin1-to-string
                   '(progn
                        (SS:FillList "tabs" (setq names (SS:AddTab names)))
                        (setq reset (append reset (list (last names))))
                        (set_tile "tabs" (setq ptr (itoa (1- (length names)))))
                    )
                )
            )

            (action_tile "cur"
                (vl-prin1-to-string
                   '(progn
                        (setq num (car (SS:ToList ptr)))
                        (setvar 'ctab (nth num names))
                        (set_tile "tabs" (setq ptr (itoa num)))
                    )
                )
            )

            ;;  Copy: the copies are appended, so they occupy the positions
            ;;  after the old end of the list -- which is how the new
            ;;  highlight is worked out without searching for them.
            (action_tile "copy"
                (vl-prin1-to-string
                   '(progn
                        (setq idx (SS:ToList ptr)
                              num (1- (length names))
                              tmp num
                        )
                        (SS:FillList "tabs" (setq names (SS:CopyTab idx names)))
                        (setq reset
                            (append reset
                                (mapcar '(lambda ( x ) (nth (setq num (1+ num)) names)) idx))
                        )
                        (set_tile "tabs"
                            (setq ptr (SS:ToValue
                                          (mapcar '(lambda ( x ) (setq tmp (1+ tmp))) idx)))
                        )
                    )
                )
            )

            (action_tile "fnr"
                (vl-prin1-to-string
                   '(progn
                        (SS:FillList "tabs" (setq names (SS:FindReplace dch names)))
                        (set_tile "tabs" ptr)
                    )
                )
            )

            (action_tile "help" "(SS:Help dch)")

            (start_dialog)
            (setq dch (unload_dialog dch))

            ;; ---- apply the new order --------------------------------------
            ;; Only if it actually differs from what is already there. TabOrder
            ;; is 1-based, and Model always occupies position 0.
            (setq layouts (SS:GetLayouts)
                  names   (mapcar 'strcase names)
            )
            (if (not (equal names (mapcar 'strcase (mapcar 'vla-get-name layouts))))
                (foreach lay layouts
                    (vla-put-taborder lay
                        (1+ (vl-position (strcase (vla-get-name lay)) names))
                    )
                )
            )
            (vla-endundomark acdoc)
            (princ (strcat "\n" (itoa (length layouts)) " layout tab"
                           (if (= 1 (length layouts)) "" "s") " in the drawing."))
        )
    )

    (SS:Restore)
    (princ)
)

;;; ===========================================================================
;;;                       L I S T   O P E R A T I O N S
;;; ===========================================================================

;;; ---------------------------------------------------------------------------
;;; SS:RemoveNth
;;;
;;; Returns the list with the item at position n removed.
;;; ---------------------------------------------------------------------------

(defun SS:RemoveNth ( n lst )
    (if (and lst (< 0 n))
        (cons (car lst) (SS:RemoveNth (1- n) (cdr lst)))
        (cdr lst)
    )
)

;;; ---------------------------------------------------------------------------
;;; SS:RemoveItems
;;;
;;; Returns the list with every item at a listed position removed.
;;;
;;; Removal is by POSITION rather than by value, so two tabs that happen to
;;; sort together are never confused for one another.
;;; ---------------------------------------------------------------------------

(defun SS:RemoveItems ( idx lst / n )
    (setq n -1)
    (vl-remove-if '(lambda ( x ) (member (setq n (1+ n)) idx)) lst)
)

;;; ---------------------------------------------------------------------------
;;; SS:ListUp
;;;
;;; Moves every item at a listed position up one place, keeping the moved
;;; items in their relative order.
;;;
;;; The list is walked once from the front. At each step:
;;;   * position 0 in the remaining indices means this item is selected but
;;;     already at the top of what is left, so it stays;
;;;   * position 1 means the item after this one is selected, so the two swap;
;;;   * anything else means this item is not involved, so it passes through.
;;;
;;; Every index is decremented as the walk advances, so they stay relative to
;;; the part of the list still to be processed. That is what makes a block of
;;; adjacent selected items move as a block instead of collapsing together.
;;; ---------------------------------------------------------------------------

(defun SS:ListUp ( idx lst )
    (cond
        (   (or (null idx) (null lst)) lst)
        (   (= 0 (car idx))
            (cons (car lst) (SS:ListUp (cdr (mapcar '1- idx)) (cdr lst)))
        )
        (   (= 1 (car idx))
            (cons (cadr lst)
                  (SS:ListUp (cdr (mapcar '1- idx)) (cons (car lst) (cddr lst)))
            )
        )
        (   (cons (car lst) (SS:ListUp (mapcar '1- idx) (cdr lst))))
    )
)

;;; ---------------------------------------------------------------------------
;;; SS:ListDown
;;;
;;; Moves every item at a listed position down one place.
;;;
;;; Moving down is moving up in a reversed list, so the list is reversed, the
;;; indices are mirrored to match, ListUp does the work, and the result is
;;; reversed back. That avoids writing and maintaining a second, mirror-image
;;; version of the same tricky logic.
;;; ---------------------------------------------------------------------------

(defun SS:ListDown ( idx lst )
    (reverse
        (SS:ListUp
            (reverse (mapcar '(lambda ( n ) (- (1- (length lst)) n)) idx))
            (reverse lst)
        )
    )
)

;;; ---------------------------------------------------------------------------
;;; SS:ListToTop / SS:ListToBottom
;;;
;;; Move every item at a listed position to the top or the bottom, keeping
;;; the moved items in their relative order and everything else in its.
;;; ---------------------------------------------------------------------------

(defun SS:ListToTop ( idx lst )
    (append (mapcar '(lambda ( n ) (nth n lst)) idx) (SS:RemoveItems idx lst))
)

(defun SS:ListToBottom ( idx lst )
    (append (SS:RemoveItems idx lst) (mapcar '(lambda ( n ) (nth n lst)) idx))
)

;;; ---------------------------------------------------------------------------
;;; SS:ReverseItems
;;;
;;; Reverses just the selected items, leaving them in the same POSITIONS but
;;; in the opposite order, and leaving unselected items untouched.
;;;
;;; So selecting rows 1, 4 and 7 of a list and reversing swaps the contents
;;; of rows 1 and 7 while row 4 stays where it is -- rows 2, 3, 5 and 6 are
;;; not disturbed at all.
;;;
;;; The list is walked once, and each time a selected position is reached the
;;; next value is taken from the reversed index list.
;;; ---------------------------------------------------------------------------

(defun SS:ReverseItems ( idx lst )
    (   (lambda ( n order )
            (mapcar
               '(lambda ( x )
                    (if (member (setq n (1+ n)) idx)
                        (setq x     (nth (car order) lst)
                              order (cdr order)
                        )
                        x
                    )
                )
                lst
            )
        )
        -1 (reverse (vl-sort idx '<))
    )
)

;;; ===========================================================================
;;;                            S O R T I N G
;;; ===========================================================================

;;; ---------------------------------------------------------------------------
;;; SS:SplitName
;;;
;;; Splits a string into alternating runs of text and numbers, so that
;;; "A-101a" becomes ("A-" 101 "a") and "Sheet 2.5" becomes ("Sheet " 2.5).
;;;
;;; This is what allows the sorts below to compare numbers as numbers. A
;;; plain alphabetic sort produces Sheet1, Sheet10, Sheet2; splitting first
;;; gives Sheet1, Sheet2, Sheet10.
;;;
;;; Decimal points are handled with care: a full stop is only treated as part
;;; of a number when a digit follows it, so "Section 2.5" gives the number
;;; 2.5, while "Plan 3. Detail" gives the number 3 followed by the text
;;; ". Detail".
;;;
;;;   str - the string to split
;;;
;;; Returns a list of strings and numbers.
;;; ---------------------------------------------------------------------------

(defun SS:SplitName ( str / chars num out part tmp )

    (setq chars (vl-string->list str)
          part  (chr (car chars))
    )
    ;; 48 to 57 are the digit characters.
    (if (< 47 (car chars) 58) (setq num t))

    (while (setq chars (cdr chars))
        (if num
            ;; ---- currently inside a number ----
            (cond
                ;;  A full stop: part of the number only if a digit follows.
                (   (= 46 (car chars))
                    (if (and (cadr chars)
                             (setq tmp (strcat "0." (chr (cadr chars))))
                             (numberp (read tmp))
                        )
                        (setq out   (cons (read part) out)
                              part  tmp
                              chars (cdr chars)
                        )
                        (setq out  (cons (read part) out)
                              part "."
                              num  nil
                        )
                    )
                )
                (   (< 47 (car chars) 58)
                    (setq part (strcat part (chr (car chars))))
                )
                ;;  A non-digit ends the number.
                (   t
                    (setq out  (cons (read part) out)
                          part (chr (car chars))
                          num  nil
                    )
                )
            )
            ;; ---- currently inside text ----
            (if (< 47 (car chars) 58)
                ;;  A digit starts a number.
                (setq out  (cons part out)
                      part (chr (car chars))
                      num  t
                )
                (setq part (strcat part (chr (car chars))))
            )
        )
    )
    ;; The final piece.
    (if num
        (setq out (cons (read part) out))
        (setq out (cons part out))
    )
    (reverse out)
)

;;; ---------------------------------------------------------------------------
;;; SS:ArchSort
;;;
;;; Sorts names the way a drawing register does.
;;;
;;; Each name is split into its text and numeric parts, and two names are
;;; compared part by part until they differ. Numbers compare as numbers, text
;;; compares as text, and where the two disagree in type the number sorts
;;; first.
;;;
;;; That is what puts A-101, A-102, A-201, A-1001, S-101 into the order an
;;; architect expects, where a plain alphabetic sort would put A-1001 between
;;; A-102 and A-201.
;;;
;;; vl-sort-i returns an index order rather than sorted values, which is what
;;; lets the original strings be reordered by comparing their split forms.
;;; ---------------------------------------------------------------------------

(defun SS:ArchSort ( lst / SS:Comparable )

    ;; Two parts can be compared directly only if they are the same kind of
    ;; thing, or one of them has run out.
    (defun SS:Comparable ( a b )
        (or (and (numberp a) (numberp b))
            (= 'str (type a) (type b))
            (not a)
            (not b)
        )
    )

    (mapcar '(lambda ( n ) (nth n lst))
        (vl-sort-i (mapcar 'SS:SplitName lst)
           '(lambda ( x1 x2 / a b same )
                ;; Walk both part-lists in step, skipping equal parts.
                (while (and (setq same (SS:Comparable (setq a (car x1)) (setq b (car x2))))
                            (= a b)
                       )
                    (setq x1 (cdr x1)
                          x2 (cdr x2)
                    )
                )
                (cond
                    ;;  One name ran out first: the shorter one sorts first,
                    ;;  so "A-1" precedes "A-1a". This is tested before the
                    ;;  comparison itself, because comparing a value against
                    ;;  nil would raise an error.
                    (   (null a) (if b t nil))
                    (   (null b) nil)
                    ;;  Same kind of part: compare directly.
                    (   same (< a b))
                    ;;  Different kinds: the number sorts first.
                    (   (numberp a))
                )
            )
        )
    )
)

;;; ---------------------------------------------------------------------------
;;; SS:NumSort
;;;
;;; Sorts names purely by the numbers inside them, ignoring the text
;;; entirely. Useful when the text prefix is the same on every sheet and only
;;; the numbering matters.
;;;
;;; Names with no numbers at all end up grouped together, since they compare
;;; as equal.
;;; ---------------------------------------------------------------------------

(defun SS:NumSort ( lst )
    (mapcar '(lambda ( n ) (nth n lst))
        (vl-sort-i
            (mapcar '(lambda ( x ) (vl-remove-if-not 'numberp (SS:SplitName x))) lst)
           '(lambda ( a b )
                (while (and a b (= (car a) (car b)))
                    (setq a (cdr a)
                          b (cdr b)
                    )
                )
                (cond
                    ;;  Both exhausted: equal as far as this sort is
                    ;;  concerned, so the original order is kept.
                    (   (and (null a) (null b)) nil)
                    ;;  One exhausted: the one with fewer numbers sorts
                    ;;  first. Tested before the comparison, because
                    ;;  comparing a number against nil would raise an error.
                    (   (null a) t)
                    (   (null b) nil)
                    (   (< (car a) (car b)))
                )
            )
        )
    )
)

(princ "\nSheetShuffle loaded. Type SHEETSHUFFLE to manage layout tabs.")
(princ)

;;; ---------------------------------------------------------------------------
;;; End of file
;;; ---------------------------------------------------------------------------