Layer Rename by selection

[CADobi-wan]

Hi All,

I have the following lisp routine that creates a new layer and adds a suffix to the end. I want to alter the lisp to create a new layer, remove the existing prefix and replace it with a new specified one. try after try I cannot get it to function correctly.

Before: C-BME-BLD would become C-BME-BLD-DEMO

Wanting: C-BME-BLD to become C-DEMO-BLD

Please HELP!!

(defun c:layrn()
(setq LsuffIX (ustr 1 "Enter layer suffix " "-DEMO" nil))
(if (not ncltlist)(load "ncltlist"))
(setq STUFF (ncltlist)
LAYLIST (car STUFF)
ENTS (cadr STUFF)
CNTR 0
)
(foreach LAYDAT LAYLIST (progn
(setq LAYNME2 (strcat (car LAYDAT) LsufFIX))
(command "layer" "m" LAYNME2 "C" (cadr LAYDAT) "" "lt" (caddr LAYDAT) "" "")
(prompt "-")
)
)
(SETQ ALIS (SSGET))
;(COMMAND "CHANGE" ALIS "" "P" "LT" "hidden2" "C" "13" "")
(repeat (sslength ENTS)
(setq ENTDAT
(subst
(cons 8
(strcat
(cdr
(setq OLD
(assoc 8
(setq ENTDAT
(entget
(setq ENTNME
(ssname ENTS CNTR)
)
)
)
)
)
) LsufFIX
)
) OLD ENTDAT
)
)
(entmod ENTDAT)
(entupd ENTNME)
(setq CNTR (1+ CNTR))
(prompt ".")
);repeat
(princ)
)
(defun ustr (bit msg def spflag / inp nval)
(if (and def (/= def ""))
(setq msg (strcat "\n" msg " <" def ">: ")
inp (getstring msg spflag)
inp (if (= inp "") def inp)
);setq
(progn
(setq msg (strcat "\n" msg ": "))
(if (= bit 1)
(while (= "" (setq inp (getstring msg spflag))))
(setq inp (getstring msg spflag))
) );progn & if
);if
inp
);defun
(defun nmelist()
(setq cntr 0
NLIST '()
ss1 (ssget)
)
(repeat (sslength ss1)
(setq LYRNME (cdr (assoc 8 (entget (ssname ss1 cntr)))))
(if (not (member LYRNME NLIST))
(setq NLIST (cons LYRNME NLIST))
)
(setq CNTR (1+ CNTR))
);repeat
(setq output (list nlist ss1))
);defun
(defun ncltlist()
(if (not nmelist)(load "nmelist"))
(setq STUFF (nmelist)
NCLT nil
NLIST (car STUFF)
ss1 (cdr STUFF)
)
(foreach LNAME NLIST (progn
(setq LDAT (tblsearch "layer" LNAME)
LCOLOR (cdr (ASSOC 62 LDAT))
LLTYPE (cdr (ASSOC 6 LDAT))
NCLT (CONS (list LNAME LCOLOR LLTYPE) NCLT)
)
)
)
(setq output (cons NCLT ss1))
);defun

Thanks in Advance!

[regisrohde]

Do you plan to change the sulfixo of all layers, or a specifies only?

[paullimapa]

This operation can simply be done using AutoCAD's built-in RENAME command (see attached screen capture)

[CADobi-wan]

I can't perform this by just using the renam command. I need to do it to create a new layer using the layer of the object that is currently selected. I don't want to change the source layer.

[ВeekeeCZ]

---

@RBastian15 wrote:

Before: C-BME-BLD would become C-BME-BLD-DEMO

Wanting: C-BME-BLD to become C-DEMO-BLD

Please HELP!!

(defun c:layrn()
(setq LsuffIX (ustr 1 "Enter layer suffix " "-DEMO" nil))
(if (not ncltlist)(load "ncltlist"))
(setq STUFF (ncltlist)
LAYLIST (car STUFF)
ENTS (cadr STUFF)
CNTR 0
)
(foreach LAYDAT LAYLIST (progn
(setq LAYNME2 (strcat (car LAYDAT) LsufFIX))
...

Thanks in Advance!

---

Change line

(setq LAYNME2 (strcat (car LAYDAT) LsufFIX))

to

(setq LAYNME1 (car LAYDAT) 
      LAYNME2 (strcat (substr LAYNME1 1 (1+ (vl-string-position (ascii "-") LAYNME1)))
			      LsufFIX
		      (substr LAYNME1 (1+ (vl-string-position (ascii "-") LAYNME1 nil T)) (strlen LAYNME1))))

[CADobi-wan]

Works Flawlessly, thanks for your input.

[CADobi-wan]

BeeKee,

It is still not working correctly as I first thought. It is now creating the correct layer ex. C-DEMO-BLD but then creating another layer C-BME-BLDDEMO and placing the object on this layer. Any thoughts on how to stop this from happening? I want it to creat only the C-DEMO-BLD layer that it is creating and place the selected object on that layer.

Thanks

Rob

[ВeekeeCZ · Accepted solution]

Try this. Rest functions are same. Changes are red.

(defun c:layrn ( / LayNameReplace)

  (defun LayNameReplace (old replace /)
    (if (vl-string-position (ascii "-") old)
      (strcat (substr old 1 (1+ (vl-string-position (ascii "-") old)))
	      replace
	      (substr old (1+ (vl-string-position (ascii "-") old nil T)) (strlen old)))
      old))
     
  (setq LsuffIX (ustr 1 "Enter layer suffix " "-DEMO" nil))
  (if (not ncltlist)
    (load "ncltlist"))
  (setq STUFF (ncltlist)
	LAYLIST (car STUFF)
	ENTS (cadr STUFF)
	CNTR 0)
  (foreach LAYDAT LAYLIST
    (progn
      (setq LAYNME2 (LayNameReplace (car LAYDAT) LsufFIX))
      (command "layer" "m" LAYNME2 "C" (cadr LAYDAT) "" "lt" (caddr LAYDAT) "" "")
      (prompt "-")))
  
  (SETQ ALIS (SSGET))
  ;(COMMAND "CHANGE" ALIS "" "P" "LT" "hidden2" "C" "13" "")
  (repeat (sslength ENTS)
    (setq ENTDAT (subst (cons 8 (LayNameReplace (cdr (setq OLD (assoc 8 (setq ENTDAT (entget (setq ENTNME (ssname ENTS CNTR))))))) LsufFIX))
			OLD
			ENTDAT))
    (entmod ENTDAT)
    (entupd ENTNME)
    (setq CNTR (1+ CNTR))
    (prompt "."));repeat
  (princ)
)

[CADobi-wan]

Success!! Your are Awesome. Are you using a program to write these so quick or is this all experience talking?

[tammy-jane.ayr]

Thank you, that was what I needed to resolve another issue I'm having.