;;; ---------------------------------------------------------------------------
;;; LayerWrap.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Adds or removes a prefix and/or suffix on layer names, in bulk.
;;;
;;; The usual reason for wanting this is a merge: you are bringing another
;;; consultant's drawing into yours and their layer names would collide with
;;; your own, so every incoming layer gets stamped with an identifying prefix.
;;; The reverse command exists for when that merge has to be unpicked again.
;;;
;;; Layers are chosen by SELECTING OBJECTS rather than by picking from a list.
;;; That sounds indirect, but it is the practical way to work: you window the
;;; drawing you just pasted in, and exactly the layers it uses get renamed,
;;; without you having to identify them by name first.
;;;
;;; COMMANDS
;;;   LAYWRAP    - add a prefix and/or suffix to the layers of selected objects
;;;   LAYUNWRAP  - remove a prefix and/or suffix from them again
;;;
;;; Renaming a layer changes the layer table, not the objects on it - so every
;;; object on that layer follows the rename automatically, including objects
;;; that were not part of the selection.
;;; ---------------------------------------------------------------------------

;; ---------------------------------------------------------------------------
;; LayerWrap:GetString
;; ---------------------------------------------------------------------------
;; Prompts for a prefix or suffix and refuses anything AutoCAD would not accept
;; in a layer name.
;;
;; The rejected set is \<>/?":;*|,=` - these are reserved by AutoCAD, and a
;; layer name containing any of them cannot be created. Validating on entry
;; means the user is told immediately, rather than discovering it later when
;; every single rename silently fails.
;;
;; An empty response is allowed and means "none", so the user can supply only a
;; prefix, only a suffix, or both.
;;
;; The t argument to getstring permits spaces, which are legal in layer names.
;; ---------------------------------------------------------------------------
(defun LayerWrap:GetString ( msg / rtn )
    (while
        (and (/= "" (setq rtn (getstring t msg)))
             (wcmatch rtn "*[\\<>/?\":;*|`,=`]*")
        )
        (princ "\nLayer names cannot contain any of  \\ < > / ? \" : ; * | , =")
    )
    rtn
)

;; ---------------------------------------------------------------------------
;; LayerWrap:Rename
;; ---------------------------------------------------------------------------
;; Renames a single layer, reporting clearly whichever way it goes.
;;
;; Three cases are handled explicitly, because each needs a different message:
;;
;;   1. The target name already exists. Layer names must be unique, so this is
;;      refused - merging two layers by renaming one onto another is not
;;      something that should happen silently.
;;
;;   2. The layer is one that cannot be renamed. Layer 0 and Defpoints are
;;      fixed by AutoCAD, and any name containing "|" belongs to an xref and is
;;      owned by the source drawing rather than by this one.
;;
;;   3. Otherwise the rename proceeds by substituting DXF group 2 - the layer
;;      name - in the layer table entry and writing it back with entmod.
;;
;; Returns the new name on success, nil otherwise, so the caller can count.
;;
;; old - [str] existing layer name
;; new - [str] desired layer name
;; ---------------------------------------------------------------------------
(defun LayerWrap:Rename ( old new / lay )
    (cond
        (   (= old new)
            nil
        )
        (   (tblsearch "layer" new)
            (princ (strcat "\n  - \"" new "\" already exists; \"" old "\" left unchanged."))
            nil
        )
        (   (wcmatch (strcase old t) "0,defpoints,*|*")
            (princ (strcat "\n  - \"" old "\" is a reserved or xref layer; cannot be renamed."))
            nil
        )
        (   (and (setq lay (tblobjname "layer" old))
                 (setq lay (entget lay))
                 (entmod (subst (cons 2 new) (assoc 2 lay) lay))
            )
            (princ (strcat "\n  + \"" old "\" renamed to \"" new "\""))
            new
        )
        (   t
            (princ (strcat "\n  - \"" old "\" could not be renamed."))
            nil
        )
    )
)

;; ---------------------------------------------------------------------------
;; LayerWrap:Process
;; ---------------------------------------------------------------------------
;; Walks a selection set, collects the distinct layers used by it, and applies
;; the supplied rename function to each one exactly once.
;;
;; The "exactly once" is the important part. The layer of every selected object
;; is examined, but a layer already seen is skipped - otherwise selecting fifty
;; objects on one layer would attempt the rename fifty times, and on the first
;; pass the layer would be renamed, with the remaining forty-nine then failing
;; noisily against a name that no longer exists.
;;
;; sel - [pickset] objects whose layers are to be renamed
;; fn  - [lambda] takes the old layer name, returns the desired new name
;; ---------------------------------------------------------------------------
(defun LayerWrap:Process ( sel fn / idx lay seen count )
    (setq idx   0
          seen  nil
          count 0
    )
    (while (setq lay (ssname sel idx))
        (setq lay (cdr (assoc 8 (entget lay))))
        (if (not (member lay seen))
            (progn
                (setq seen (cons lay seen))
                (if (LayerWrap:Rename lay (apply fn (list lay)))
                    (setq count (1+ count))
                )
            )
        )
        (setq idx (1+ idx))
    )
    (princ (strcat "\n" (itoa count) " of " (itoa (length seen))
                   " layer" (if (= 1 (length seen)) "" "s") " renamed."
           )
    )
    (princ)
)

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

;; ---------------------------------------------------------------------------
;; c:LAYWRAP  -  add a prefix and/or suffix
;; ---------------------------------------------------------------------------
(defun c:LAYWRAP ( / *error* vars vals pre suf sel )

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

    (defun *error* ( msg )
        (LayerWrap:Restore vars vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** LAYWRAP error: " msg " **"))
        )
        (princ)
    )

    (setvar "CMDECHO" 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")

    (setq pre (LayerWrap:GetString "\nSpecify layer prefix <none>: ")
          suf (LayerWrap:GetString "\nSpecify layer suffix <none>: ")
    )

    ;; (= "" pre suf) is true only when BOTH are empty, which would make the
    ;; whole operation a no-op, so the user is stopped before selecting.
    (cond
        (   (= "" pre suf)
            (princ "\nNo prefix or suffix given - nothing to do.")
        )
        (   (not (setq sel (ssget)))
            (princ "\nNothing selected.")
        )
        (   t
            (LayerWrap:Process sel
                (function (lambda ( lay ) (strcat pre lay suf)))
            )
        )
    )

    (LayerWrap:Restore vars vals)
    (princ)
)

;; ---------------------------------------------------------------------------
;; c:LAYUNWRAP  -  remove a prefix and/or suffix
;; ---------------------------------------------------------------------------
(defun c:LAYUNWRAP ( / *error* vars vals pre suf sel )

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

    (defun *error* ( msg )
        (LayerWrap:Restore vars vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** LAYUNWRAP error: " msg " **"))
        )
        (princ)
    )

    (setvar "CMDECHO" 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")

    (setq pre (LayerWrap:GetString "\nSpecify layer prefix to remove <none>: ")
          suf (LayerWrap:GetString "\nSpecify layer suffix to remove <none>: ")
    )

    (cond
        (   (= "" pre suf)
            (princ "\nNo prefix or suffix given - nothing to do.")
        )

        ;; The selection is filtered to layers actually matching the pattern,
        ;; so objects on unrelated layers cannot be picked up by a sloppy
        ;; window and reported as failures.
        (   (not (setq sel (ssget (list (cons 8 (strcat pre "*" suf))))))
            (princ (strcat "\nNo objects found on layers matching \"" pre "*" suf "\""))
        )

        (   t
            (LayerWrap:Process sel
                (function
                    (lambda ( lay )
                        ;; Strip both ends by taking the middle of the string:
                        ;; start one character past the prefix, and run for the
                        ;; original length less both the prefix and the suffix.
                        (substr lay
                                (1+ (strlen pre))
                                (- (strlen lay) (strlen pre) (strlen suf))
                        )
                    )
                )
            )
        )
    )

    (LayerWrap:Restore vars vals)
    (princ)
)

(princ)