Topic: Place prefix in front Layer name

[Fabricio28]

Hi all,

I'm looking for a routine will place a Prefix (-) in front of a layers names by selected objects.
e.g
Layer Name: STREET
Layer Name: - STREET

Anybody Can help me please?

Kind Regards

[Krushert]

I have no idea where I got this.  I had to go to the Lisp Trunk in attic to get it because I really do not use it much more.
I think I got it from Cadalyst.    It was probably authored by a Swamp Denizen anyway. 

Code: [Select]

;;; LAYER-NAME-CHANGE.LISP
;;; CHANGES LAYER NAME BY ADDING A PREFIX OR/AND SUFFIX

(defun C:ChgLayName (/ acadDocument theLayers layName pre)
  (vl-load-com)
    (vl-cmdf ".undo" "begin")
  (setq p_fix (getstring "\nEnter Layer Prefix : ")
s_fix (getstring "\nEnter Layer Suffix : ")
  )
  (setq acadDocument (vla-get-activedocument (vlax-get-acad-object)))
  (setq theLayers (vla-get-layers acadDocument))
  (vlax-map-collection theLayers 'layer-mod)
  (vl-cmdf ".undo" "end")
  (princ)
) ;defun

(defun layer-mod (theLayer)
  (setq layName (vlax-get-property theLayer 'Name))
  (if (not (member layName '("0" "Defpoints" "XREF")))
    (vla-put-Name thelayer (strcat p_fix layName s_fix))
  ) ;if
) ;defun
FWIW:  I was just recently shown that Rename command can utilize wild cards to add or strip prefixes or suffixes from layer names.
Thanks TedG

[ronjonp]

You could also use something like this:

Code: [Select]

(defun c:foo (/ e el l pre)
  (if (and (setq e (car (entsel))) (setq pre (getstring t "\nEnter prefix: ")))
    (progn (setq l (cdr (assoc 8 (entget e))))
      (setq el (entget (tblobjname "layer" l)))
      (if (wcmatch (strcase l) (strcat (strcase pre) "*"))
        (princ "\nLayer already has that prefix...")
        (entmod (subst (cons 2 (strcat pre l)) (assoc 2 el) el))
      )
    )
  )
  (princ)
)

[Fabricio28]

Thank you for the quick replay guys,

@Krushert
Thank for sharing the code, but isn't exacatly I was looking for.
Regards

You could also use something like this:

It is perfect, ronjonp!
Is it possible add multiple section in the code, please?

Best Regards

[ronjonp]

Here you go:

Code: [Select]

(defun c:foo (/ _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)))
    (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) "*"))
(princ "\nLayer already has that prefix...")
(entmod (subst (cons 2 (strcat pre l)) (assoc 2 el) el))
      )
    )
  )
  (princ)
)

[Fabricio28]

You're awesome!!!
Thank you very much.

Fabricio

[ronjonp]

Glad to help.

[MSTG007]

I thought I did something wierd here. I used the FOO command; and the entity i selected was renamed to the new layer, but so did all the other objects on that layer. Am I doing something wrong?

I have layer 1 and select an object. Then would assign a prefix line demo_; and finally look like in the layer name as demo_1?

Thanks

[ronjonp]

Sorry about that .. the routine above just renames the layer. If you want the object to be moved to the new layer use the code below.

Code: [Select]

(defun c:foo (/ _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)
)

[MSTG007]

whoot! Again you dah man!

[ronjonp]

 

[engtechy]

I realize this is an old post. I know enough about lisp to be dangerous.... how would I modify that last routine to add a suffix instead of the prefix?

Thanks.

[rkmcswain]

I realize this is an old post. I know enough about lisp to be dangerous.... how would I modify that last routine to add a suffix instead of the prefix?

Try this:

Code: [Select]

(defun c:foo (/ _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 suffix: ")) (setq ss (ssget)))
    (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)))
(princ "\nLayer already has that suffix...")
(entmod (subst (cons 2 (strcat l pre)) (assoc 2 el) el))
      )
    )
  )
  (princ)
)


[Fabricio28]

Here you go:

Code: [Select]

(defun c:foo (/ _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)))
    (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) "*"))
(princ "\nLayer already has that prefix...")
(entmod (subst (cons 2 (strcat pre l)) (assoc 2 el) el))
      )
    )
  )
  (princ)
)

Hi guys,


That code is amazing, I've been using a lot ...

I'm using that code to add - as a prefix of my layers.

I'd like to make a little change at the code.
Remove - of all selected layers.


Thanks in advance

[ribarm]

Hi guys,


That code is amazing, I've been using a lot ...

I'm using that code to add - as a prefix of my layers.

I'd like to make a little change at the code.
Remove - of all selected layers.


Thanks in advance

If I understood correctly and if the code passed your tests... (untested)

Code: [Select]

(defun c:foo ( / _ss->list f-MR e el l ll ss )
  (defun _ss->list ( ss / n out )
    (repeat (setq n (sslength ss)) (setq out (cons (ssname ss (setq n (1- n))) out)))
  )
  (defun f-MR ( d s / d1 dl k ss c pl z l )
    (while (and (setq d1 (substr d 1 1)) (/= d1 ""))
      (setq d (substr d 2))
      (setq dl (cons d1 dl))
    )
    (foreach d1 dl
      (setq k -1 ss s)
      (while (and (setq c (substr ss 1 1)) (/= c ""))
        (setq ss (substr ss 2))
        (setq k (1+ k))
        (if (= c d1)
          (setq pl (cons k pl))
        )
      )
    )
    (if pl
      (progn
        (setq pl (vl-sort pl '<))
        (foreach p pl
          (if (null z)
            (setq z 1)
          )
          (setq l (cons (substr s z (1+ (- p z))) l))
          (setq z (+ p 2))
        )
        (setq l (cons (substr s z) l))
        (vl-remove "" (reverse l))
      )
      s
    )
  )
  (if (setq ss (ssget))
    (foreach e (_ss->list ss)
      (setq l (cdr (assoc 8 (entget e))))
      (setq el (entget (tblobjname "layer" l)))
      (if (vl-string-search "-" l)
        (progn
          (setq ll (f-MR "-" l))
          (setq ll (apply 'strcat ll))
          (entmod (subst (cons 2 ll) (assoc 2 el) el))
        )
      )
    )
  )
  (princ)
)

Regards...