Renommer des calques par rechercher-remplacer

Du texte brut, rien de caché. Copiez-le dans un fichier nommé cxlayren.lsp ou téléchargez-le.

;;; ============================================================================
;;; CXLAYREN - Rename layers by find and replace
;;; Version 1.0.0
;;; CADXChange LISP tools - https://cadxchange.net/resources/lisp/cxlayren
;;; Tested in: AutoCAD (full version). Other programs that run AutoLISP may work but are not tested.
;;; Copyright (c) CADXChange. Free for personal and commercial use; do not resell or
;;; republish it as a collection. Terms: https://cadxchange.net/legal/lisp-terms
;;; ============================================================================

;; Rename layers by replacing the text FIND with REPL in every layer name (case ignored). Layer 0, Defpoints and
;; names that would clash with an existing layer are left alone.
;; Returns the changes as ((old . new) ...).
(defun cx:layren-run (find repl / out new)
  (if (> (strlen find) 0)
    (foreach name (cx:layers)
      (setq new (cx:replace-ci name find repl))
      (if (and (/= new name)
               (/= name "0")
               (/= (strcase name) "DEFPOINTS")
               (> (strlen new) 0)
               (not (cx:bad-name new))
               (not (tblsearch "LAYER" new)))
        (if (cx:lay-rename name new)
          (setq out (cons (cons name new) out))))))
  (reverse out))

(defun c:CXLAYREN ( / *error* cx:sv find repl r)
  (setq *error* cx:err)
  (setq find (cx:ask-str "Text to find in layer names" ""))
  (if (= find "")
    (princ "\nNothing to find.")
    (progn
      (setq repl (cx:ask-str "Replace it with (- for nothing)" ""))
      (cx:start '(("CMDECHO" . 0)))
      (setq r (cx:layren-run find repl))
      (foreach p r (princ (strcat "\n" (car p) "  ->  " (cdr p))))
      (princ (strcat "\n" (itoa (length r)) " layer(s) renamed."))
      (cx:end)))
  (princ))


;;; ---- Shared helpers (used by the command above; identical in every CADXChange tool) ----

(defun cx:dxf (code ed)
  (cdr (assoc code ed)))

;; Names of all layers.
(defun cx:layers (/ r out)
  (setq r (tblnext "LAYER" T))
  (while r
    (setq out (cons (cx:dxf 2 r) out) r (tblnext "LAYER")))
  (reverse out))

;; Replace every OLD in STR by NEW, ignoring case.
(defun cx:replace-ci (str old new / n out pos up uo)
  (setq n (strlen old) out "" pos 1 up (strcase str) uo (strcase old))
  (if (= n 0)
    str
    (progn
      (while (<= pos (1+ (- (strlen str) n)))
        (if (= (substr up pos n) uo)
          (setq out (strcat out new) pos (+ pos n))
          (setq out (strcat out (substr str pos 1)) pos (1+ pos))))
      (strcat out (substr str pos)))))

;; 1-based position of SUB in STR at or after START, or nil.
(defun cx:find (str sub start / n i r)
  (setq n (strlen sub) i start r nil)
  (if (> n 0)
    (while (and (not r) (<= i (1+ (- (strlen str) n))))
      (if (= (substr str i n) sub) (setq r i))
      (setq i (1+ i))))
  r)

;; True when STR holds a character that is not allowed in a layer, block or style name.
(defun cx:bad-name (str / bad)
  (foreach ch '("<" ">" "/" "\\" "\"" ":" ";" "?" "*" "|" "=" "`" ",")
    (if (cx:find str ch 1) (setq bad T)))
  bad)

;;; List helpers. See helpers.lsp for the format.

;; Rename layer OLD to NEW; returns T when it worked.
(defun cx:lay-rename (old new)
  (command "_.RENAME" "_LA" old new)
  (if (and (tblsearch "LAYER" new) (not (tblsearch "LAYER" old))) T))

;; Close the undo step and put the system variables back.
(defun cx:end ()
  (foreach v cx:sv (setvar (car v) (cdr v)))
  (command "_.UNDO" "_End")
  (setq cx:sv nil)
  (princ))

;; Error handler: restores everything, stays quiet on Esc.
(defun cx:err (msg)
  (if (> (getvar "CMDACTIVE") 0) (command))
  (cx:end)
  (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg)))
  (princ))

;; Ask for a string (spaces allowed) with a default; "-" means an empty string.
(defun cx:ask-str (msg def / v)
  (setq v (getstring T (strcat "\n" msg " <" def ">: ")))
  (cond ((= v "") def) ((= v "-") "") (T v)))

;; Save the system variables in VARS ((name . value) ...), set them, and open one undo step.
;; The caller declares cx:sv as a local so the saved values live exactly as long as the command.
(defun cx:start (vars)
  (setq cx:sv (mapcar (function (lambda (v) (cons (car v) (getvar (car v))))) vars))
  (command "_.UNDO" "_Begin")
  (foreach v vars (setvar (car v) (cdr v)))
  (princ))

(princ "\nCXLAYREN loaded. Type CXLAYREN to start.")
(princ)

Autres commandes : Calques

• CXLAYISOIsoler les calques des objets que vous désignez
• CXLAYRESRétablir les calques désactivés par CXLAYISO
• CXLAYOFFDésactiver les calques des objets que vous désignez
• CXLAYCOLORChanger la couleur des calques que vous désignez
• CXLAYSETDéplacer des objets sur le calque d'un autre objet
• CXLAYMRGFusionner des calques en un seul et supprimer les autres
• CXLAYCOUNTCompter les objets de chaque calque
• CXLAYSELSélectionner tout ce qui est sur les calques que vous désignez
• CXLAYSTDCréer un jeu de calques à partir d'une liste CSV