Topic: Trying to get a Lisp to Erase a Layer Prefix

[MSTG007]

I having been messing around with this lisp, trying to get it to remove all layers with a prefix (DEMO_*) to be replaced with (EX_*).

DEMO_PAVEMENT
to
EX_PAVEMENT

Thanks guys for any help!

Code: [Select]

(defun c:demo (/ _ss->list e el l pre ss)
  (defun _ss->list (ss / n out)
    (repeat (setq n (sslength ss)) (setq out (cons (ssname ss (setq n (1- n))) out)))
  )
  (if (and (setq pre (getstring t "\nEnter prefix: ")) (setq ss (ssget)))
    (progn (foreach e (_ss->list ss)
      (setq l (cdr (assoc 8 (entget e))))
      (setq el (entget (tblobjname "layer" l)))
      (if (wcmatch (strcase l) (strcat (strcase pre) "*"))
        (progn (princ "\nObject already has that layer prefix..."))
        (progn (if (not (tblobjname "layer" (strcat pre l)))
(entmakex (subst (cons 2 (strcat pre l)) (assoc 2 el) el))
       )
       (entmod (subst (cons 8 (strcat pre l)) (assoc 8 (entget e)) (entget e)))
        )
      )
    )
    )
  )
  (princ)
)

[ronjonp]

You could use the rename command for this.

[MSTG007]

I am playing around with the -rename (I was thinking about doing a macro for this) but how can I get it to do multiple selections at a time? I will keep looking at it.

[Tharwat]

If I may .

Code - Auto/Visual Lisp: [Select]

1. (while (setq b (tblnext "LAYER" (not b)))
2.   (if (and (wcmatch (strcase (setq n (cdr (assoc 2 b)))) "DEMO_*")
3.            (not(tblsearch "LAYER" (setq r (strcat "EX_" (substr n 5)))))
4.       )
5.     (entmod (subst (cons 2 r) (assoc 2 (setq e (entget (tblobjname "LAYER" n))))
6.              e
7.       )
8.     )
9.   )
10. )

[ronjonp]

Here's a quick snippet to change a layer prefix:

Code - Auto/Visual Lisp: [Select]

1. (defun c:lprefix (/ ln new old)
2.   (vl-load-com)
3.   (setq old "DEMO_")
4.   (setq new "EX_")
5.   (vlax-for lay   (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
6.     (if   (wcmatch (strcase (setq ln (vla-get-name lay))) (strcase (strcat old "*")))
7.       (vla-put-name lay (strcat new (substr ln (1+ (strlen old)))))
8.     )
9.   )
10.   (princ)
11. )

[MSTG007]

lol why is this so easy for you guys! lol. I some times have the hardest time trying to figure this code out. Thanks again for the help though.

[BlackBox]

[Edit] - @%#$&!; Ninja-ed by ronjonp, but mine supports UNDO. 

Code - Auto/Visual Lisp: [Select]

1. (vl-load-com)
2.  
3. (defun c:LayerRename (/ *error* old new acDoc oLayers i oldName newName)
4.  
5.   (defun *error* (msg)
6.     (if acDoc (vla-endundomark acDoc))
7.     (cond ((not msg))                                                   ; Normal exit
8.           ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
9.           ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
10.     )
11.     (princ)
12.   )
13.  
14.   (if (and (setq old (getstring T "\nEnter string to replace: "))
15.            (setq new (getstring T "\nEnter replacement string: "))
16.       )
17.     (progn
18.       (vla-startundomark
19.         (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
20.       )
21.       (setq oLayers (vla-get-layers acDoc))
22.       (setq i 0)
23.       (vlax-for x oLayers
24.         (if (vl-string-search old (setq oldName (vla-get-name x)))
25.           (if
26.             (tblsearch "layer"
27.                        (setq newName (vl-string-subst new old oldName)) ; single replacement only
28.             )
29.              (prompt
30.                (strcat
31.                  "\nLayer \"" newName "\" already exists. "
32.                  "Move all objects, then delete layer \"" oldName "\" "
33.                 )
34.              )
35.              (progn
36.                (vla-put-name x newName)
37.                (setq i (1+ i))
38.              )
39.           )
40.         )
41.       )
42.       (prompt
43.         (strcat "\n" (itoa i) " layer" (if (= 1 i) "s " " ") "renamed. ")
44.       )    
45.     )
46.   )
47.  
48.   (*error* nil)
49. )
50.  

[MSTG007]

Ok here is where I am at. The lisp I posted takes a layer name that I selected in the drawing and adds the (DEMO_) in front of the layer name. I was hoping I could reverse that process. Where if I select an object on the (DEMO_Water line) it will remove the (DEMO_) and replace it with (EX_) and back onto the original layer if its there, and if not it can create the layer. Hopefully that makes alittle sense.

[ronjonp]

Ok here is where I am at. The lisp I posted takes a layer name that I selected in the drawing and adds the (DEMO_) in front of the layer name. I was hoping I could reverse that process. Where if I select an object on the (DEMO_Water line) it will remove the (DEMO_) and replace it with (EX_) and back onto the original layer if its there, and if not it can create the layer. Hopefully that makes alittle sense.

Try this:

Code - Auto/Visual Lisp: [Select]

1. (defun c:lprefix2 (/ _ss->list el l new nl old ss)
2.   (defun _ss->list (ss / n out)
3.     (repeat (setq n (sslength ss)) (setq out (cons (ssname ss (setq n (1- n))) out)))
4.   )
5.   (setq old "DEMO_")
6.   (setq new "EX_")
7.   (if (setq ss (ssget ":L" (list (cons 8 (strcat old "*")))))
8.     (foreach e (_ss->list ss)
9.       (setq el (entget (tblobjname "layer" (setq l (cdr (assoc 8 (entget e)))))))
10.       (setq nl (strcat new (substr l (1+ (strlen old)))))
11.       ;; Create new layer matching old layer properties
12.       (entmake (subst (cons 2 nl) (assoc 2 el) el))
13.       ;; Move item to new layer
14.       (entmod (subst (cons 8 nl) (assoc 8 (entget e)) (entget e)))
15.     )
16.   )
17.   (princ)
18. )

[lamarn]

For these occasion's I use rrename.vlx. Could try it. Works good.
http://www.cadforum.cz/cadforum_en/rename-on-steroids-complex-renaming-of-autocad-objects-tip9265

[MSTG007]

BOOM! Thanks for sharing all the different ways to do this. This is awesome!

[ronjonp]

BOOM! Thanks for sharing all the different ways to do this. This is awesome!