CADXChange

Tutti i comandi LISP

CXLAYRENLayerVersione 1.0.0Provato in AutoCAD

Rinominare i layer con trova e sostituisci

Rinomina molti layer in una volta sostituendo una parte del nome, per esempio OLD- con NEW-, e mostra che cosa è stato cambiato.

Come si usa

  1. Digita CXLAYREN.
  2. Inserisci il testo da cercare nei nomi dei layer.
  3. Inserisci il sostituto (- per niente).

Da sapere

  • Il layer 0, Defpoints e i nomi che entrerebbero in conflitto con un layer esistente restano invariati.

Caricarlo in AutoCAD

  1. Salva il file dove preferisci.
  2. Digita APPLOAD, scegli il file e premi Carica.
  3. Digita il nome del comando: CXLAYREN.

Per averlo a ogni avvio, aggiungilo alla Raccolta di avvio nella stessa finestra, oppure carica un'intera cartella in una volta con il caricatore facoltativo. Il caricatore facoltativo

Provato in AutoCAD (versione completa). Altri programmi che eseguono AutoLISP potrebbero funzionare, ma non sono stati provati.

Il codice

Testo semplice, niente di nascosto. Copialo in un file chiamato cxlayren.lsp oppure scaricalo.

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

Cronologia delle versioni

Versione 1.0.0 · 27 ottobre 2026

Prima versione.

Ti serve su molti disegni?

LayerSync svolge questo tipo di lavoro su un'intera cartella di disegni in un solo passaggio.

LayerSync

Altri comandi: Layer