;;; ---------------------------------------------------------------------------
;;; AttOrder.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; SET THE ORDER ATTRIBUTES WILL BE PROMPTED IN
;;;
;;; PURPOSE
;;;   Before a block is made from a set of attribute definitions, this fixes the
;;;   order they will be asked for in.
;;;
;;;   The order comes from the order the ATTDEFs sit in the drawing database,
;;;   and a window selection picks them up newest first - so a title block drawn
;;;   in a sensible order gets its prompts in reverse, and one edited over time
;;;   gets them in no order at all.
;;;
;;;   Selecting them one at a time in the right order works, but on a title
;;;   block with twenty fields it is a long and unforgiving job.
;;;
;;; HOW THE ORDER IS CHANGED
;;;   An attribute definition cannot be moved within the database. What can be
;;;   done is to copy one onto itself and delete the original - which puts a
;;;   fresh copy at the END of the database. Do that to each in the order you
;;;   want and they come out in that order.
;;;
;;;   Everything about each one is preserved, because it is a genuine copy.
;;;
;;; AFTERWARDS
;;;   For attributes in a block that ALREADY EXISTS, use BATTMAN instead - it
;;;   reorders them in the definition without any of this. This is for the stage
;;;   before the block is made.
;;;
;;; WHAT WAS FIXED
;;;   - When no attribute definitions were found it called (*error* "...")
;;;     directly - invoking the error handler as though an error had occurred,
;;;     from code that had merely found nothing.
;;;   - It listed at most forty definitions and silently ignored any beyond
;;;     that, which on a large title block is exactly where the problem is.
;;;   - CMDECHO was set to 1 at the end rather than to what it had been.
;;;   - Its display wrote straight to the text screen with no way to go back and
;;;     look again mid-edit.
;;;
;;;   ATTORDER  - set the prompting order of attribute definitions
;;; ---------------------------------------------------------------------------

;;; Pad or clip a string to an exact width so the table lines up.
(defun Ord:Pad ( s w )
    (setq s (substr s 1 w))
    (while (< (strlen s) w) (setq s (strcat s " ")))
    s
)

;;; Move item at FROM to position TO in a list, both 1-based.
(defun Ord:Move ( lst from to / item out i )
    (setq item (nth (1- from) lst)
          out  nil i 1)
    ;; Take it out first, then put it back at the new place - doing both in one
    ;; pass is where off-by-one errors live.
    (foreach x lst
        (if (/= i from) (setq out (cons x out)))
        (setq i (1+ i)))
    (setq out (reverse out) lst nil i 1)
    (foreach x out
        (if (= i to) (setq lst (cons item lst)))
        (setq lst (cons x lst) i (1+ i)))
    (if (> to (length out)) (setq lst (cons item lst)))
    (reverse lst)
)

(defun c:ATTORDER ( / *error* vars vals ss i ent items done v from to n
                      changed line )

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

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

    (setvar "CMDECHO" 0)
    (setvar "HIGHLIGHT" 0)
    ;; AutoCAD 2015 and later refuse (command) inside an *error* handler unless
    ;; the routine says up front that it will use one.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")

    (princ "\nSelect the attribute definitions, or press Enter for all of them.")
    (setq ss (ssget '((0 . "ATTDEF"))))
    (if (null ss) (setq ss (ssget "_X" '((0 . "ATTDEF")))))

    (if (null ss)
        (princ "\nThere are no attribute definitions in this drawing.")
        (progn
            ;; Read them in database order, which is the order they would be
            ;; prompted in as things stand.
            (setq items nil i 0)
            (while (< i (sslength ss))
                (setq ent (ssname ss i)
                      v   (entget ent)
                      items (cons (list ent
                                        (cdr (assoc 2 v))
                                        (cond ((cdr (assoc 3 v))) (t "")))
                                  items)
                      i (1+ i)))
            (setq items (reverse items) n (length items) changed nil done nil)

            (while (not done)
                ;; The whole list, however long - not the first forty.
                (princ "\n\n  NO  TAG              PROMPT")
                (princ "\n  --  ---------------  --------------------------")
                (setq i 1)
                (foreach it items
                    (princ (strcat "\n  " (Ord:Pad (itoa i) 4)
                                   (Ord:Pad (cadr it) 17)
                                   (caddr it)))
                    (setq i (1+ i)))

                (initget 6)
                (setq from (getint (strcat "\n\nMove which number"
                                           " <Enter when the order is right>: ")))
                (if (or (null from) (> from n))
                    (setq done t)
                    (progn
                        (initget 6)
                        (setq to (getint (strcat "  To position (1 to "
                                                 (itoa n) "): ")))
                        (if (and to (<= to n) (/= to from))
                            (setq items (Ord:Move items from to)
                                  changed t)))))

            (if (null changed)
                (princ "\nOrder left as it was.")
                (progn
                    ;; Rebuild each one at the end of the database, in order.
                    ;; A copy onto itself then delete the original is the only
                    ;; way to move an attribute definition.
                    (foreach it items
                        (command "_.COPY" (car it) "" "0,0" "0,0")
                        (entdel (car it)))
                    (princ (strcat "\n" (itoa n) " attribute definitions"
                                   " reordered."
                                   "\nMake the block now - they will be asked"
                                   " for in this order."))))
        )
    )

    (Ord:Restore)
    (princ)
)

(princ)