Layer Lisp

[Lee Mac]

Or, using Entmod:

 

(defun c:lay (/ ent Nme obj)
 (vl-load-com)
 (while (setq ent (car (entsel "\nSelect Object on Layer: ")))
   (setq Nme (cdr (assoc 8 (entget ent))) obj (tblobjname "LAYER" Nme))
   (if (= 14 (strlen Nme))
       (entmod
         (subst
           (cons 2 (strcat Nme "_EX"))
             (assoc 2 (entget obj)) (entget obj)))
   (princ (strcat "\n<< Layer: " Nme " is not Standard Format >>"))))
 (princ))

[alanjt]

Blimey, this is an old thread... brings back some memories - I've come a long way since then!

 

Try this:

 

(defun c:lay (/ ent Nme)
 (vl-load-com)
 (while (setq ent (car (entsel "\nSelect Object on Layer: ")))
   (setq Nme (cdr (assoc 8 (entget ent))))
   (if (= 14 (strlen Nme))
     (vla-put-Name
       (vla-item
         (vla-get-Layers
           (vla-get-ActiveDocument
             (vlax-get-acad-object))) Nme)
       (strcat Nme "_EX"))
     (princ (strcat "\n<< Layer: " Nme " is not Standard Format >>"))))
 (princ))
   

keep beating me to the punch. i clicked reply, then got up for a second, came back and finished my post and you beat me in.

 

this was a while ago.

[Lee Mac]

Hehe

[kalarpu]

Hi

Thanks you for answering.

I have some more question please.

-Only

-If the selected obj layer >14, just copy 14 only and create new layer and then add _E and then also change colour to "4"

-If 14_E is the existing layer, just changed the selected obj (which have first 14 exactly same to Existing 14 of 14_E ) to the existing layer

-Can be select multi objs

 

Thanks guys

Kalarpu

[Lee Mac]

1. The message can easily be changed.
   
2. This can also be achieved.
   
3. Not sure I understand what you mean by this one.
   
4. Perhaps...

[Lee Mac]

Perhaps something like this?

 

(defun c:lay (/ suff i ss ent Nme Obj nNme)
 (vl-load-com)

 (setq suff "_EX")   ;; Layer Suffix
 
 (setq lay (vla-get-Layers
             (vla-get-ActiveDocument
               (vlax-get-acad-object))))

 (if (setq i -1 ss (ssget "_:L"))
   (while (setq ent (ssname ss (setq i (1+ i))))
     (setq Nme (cdr (assoc 8 (entget ent)))
           Obj (vlax-ename->vla-object ent))

     
     (cond ((= 14 (strlen Nme))
            (if (tblsearch "LAYER" (setq nNme (strcat Nme suff)))
              (vla-put-layer Obj nNme)
              (vla-put-Name (vla-item lay Nme) nNme)))
           
           ((< 14 (strlen Nme))
            (setq nNme (strcat (substr Nme 1 14) suff))
            (if (tblsearch "LAYER" nNme)
              (vla-put-layer Obj nNme)
              (progn
                (vla-put-color (vla-add lay nNme) acCyan)
                (vla-put-Layer Obj nNme))))

           (t (princ
                (strcat "\n** Layer: " Nme " is not a Standard Format"))))))

 (princ))

[alanjt]

nice lee, i still think it should filter based on prefix. if it's a layering standard, it will begin with the same stuff. just for that 'one time' when a crazy layer exists with 14 characters, but doesn't follow layer standards.

(and (= (strlen "LAYERNAME") 14)
    (wcmatch "LAYERNAME" "[AECMV ]-*")
    )

the second portion of this (what i posted earlier) will take care of that.

 

 

Perhaps something like this?

 

(defun c:lay (/ suff i ss ent Nme Obj nNme)
 (vl-load-com)

 (setq suff "_EX")   ;; Layer Suffix
 
 (setq lay (vla-get-Layers
             (vla-get-ActiveDocument
               (vlax-get-acad-object))))

 (if (setq i -1 ss (ssget "_:L"))
   (while (setq ent (ssname ss (setq i (1+ i))))
     (setq Nme (cdr (assoc 8 (entget ent)))
           Obj (vlax-ename->vla-object ent))

     
     (cond ((= 14 (strlen Nme))
            (if (tblsearch "LAYER" (setq nNme (strcat Nme suff)))
              (vla-put-layer Obj nNme)
              (vla-put-Name (vla-item lay Nme) nNme)))
           
           ((< 14 (strlen Nme))
            (setq nNme (strcat (substr Nme 1 14) suff))
            (if (tblsearch "LAYER" nNme)
              (vla-put-layer Obj nNme)
              (progn
                (vla-put-color (vla-add lay nNme) acCyan)
                (vla-put-Layer Obj nNme))))

           (t (princ
                (strcat "\n** Layer: " Nme " is not a Standard Format"))))))

 (princ))

[Lee Mac]

Good point AJ, will just have to see how the OP proceeds

[kalarpu]

Hi Lee and Alan

Thanks a lot

Sorry for my poor ENGLISH

You did what I want.

Thanks again

 

Kalarpu

[alanjt]

Hi Lee and Alan

Thanks a lot

Sorry for my poor ENGLISH

You did what I want.

Thanks again

 

Kalarpu

No worries. I'm American, mine is not much better.

 

funny, i never capitalize for sentence structure when posting.

[Lee Mac]

Hi Lee and Alan

Thanks a lot

Sorry for my poor ENGLISH

You did what I want.

Thanks again

 

Kalarpu

 

Not a problem - we managed to understand OK

[kalarpu]

Hi

I don't know how to combine Alan one to Lee one

Please help me

Thanks

 

Kalarpu

[Lee Mac]

Just replace

 

(= 14 (strlen Nme))

 

With Alan's code.

 

You may also want to do the same with the (

[alanjt]

(and (or (= (strlen Nme) 14)
        (wcmatch Nme "*_EX")
    )
    (wcmatch Nme "[AECMV ]-*")
    )

this might cover it a little better. that way, it won't throw a fit if it sees a layer with the "_EX" already. or am i not thinking propertly and just being redundant?

[Lee Mac]

My routine does check for the layer already existing and puts the object on that layer if it does.

 

But that is assuming that the layer is not 14 chrs WITH the _EX on the end...

[alanjt]

My routine does check for the layer already existing and puts the object on that layer if it does.

 

But that is assuming that the layer is not 14 chrs WITH the _EX on the end...

ah hah!

[Lee Mac]

ah hah!

 

I saw your Nelson

[alanjt]

I saw your Nelson

it worked?!

after i posted it, it didn't show up, so i took it out.

[Lee Mac]

it worked?!

after i posted it, it didn't show up, so i took it out.

 

I saw the jumbled code and curiosity got the better of me

[kalarpu]

;This program is produced by LEE MAC and edited by Alanjt for Kalarpu

;;;;;;;;------;;;;;;;;

;STANDARD LAYERS

(defun c:layO (/ suff i ss ent Nme Obj nNme)

(vl-load-com)

(setq suff "") ;; Layer Suffix

 

(setq lay (vla-get-Layers

(vla-get-ActiveDocument

(vlax-get-acad-object))))

(if (setq i -1 ss (ssget "_:L"))

(while (setq ent (ssname ss (setq i (1+ i))))

(setq Nme (cdr (assoc 8 (entget ent)))

Obj (vlax-ename->vla-object ent))

 

(cond ((and (= 14 (strlen Nme))(wcmatch Nme "[ACELMNS ]-*"))

(if (tblsearch "LAYER" (setq nNme (strcat Nme suff)))

(vla-put-layer Obj nNme)

(vla-put-Name (vla-item lay Nme) nNme)))

 

((and(

(setq nNme (strcat (substr Nme 1 14) suff))

(if (tblsearch "LAYER" nNme)

(vla-put-layer Obj nNme)

(progn

(vla-put-color (vla-add lay nNme) acwhite)

(vla-put-Layer Obj nNme))))

(t (princ

(strcat "\n** Layer: " Nme " is not a Standard Format"))))))

(princ))

;EXISTING/APPROVED TO BE REMAIN

(defun c:layE (/ suff i ss ent Nme Obj nNme)

(vl-load-com)

(setq suff "_E") ;; Layer Suffix

 

(setq lay (vla-get-Layers

(vla-get-ActiveDocument

(vlax-get-acad-object))))

(if (setq i -1 ss (ssget "_:L"))

(while (setq ent (ssname ss (setq i (1+ i))))

(setq Nme (cdr (assoc 8 (entget ent)))

Obj (vlax-ename->vla-object ent))

 

(cond ((and (= 14 (strlen Nme))(wcmatch Nme "[ACELMNS ]-*"))

(if (tblsearch "LAYER" (setq nNme (strcat Nme suff)))

(vla-put-layer Obj nNme)

(vla-put-Name (vla-item lay Nme) nNme)))

 

((and(

(setq nNme (strcat (substr Nme 1 14) suff))

(if (tblsearch "LAYER" nNme)

(vla-put-layer Obj nNme)

(progn

(vla-put-color (vla-add lay nNme) acCyan)

(vla-put-Layer Obj nNme))))

(t (princ

(strcat "\n** Layer: " Nme " is not a Standard Format"))))))

(princ))

;PROPOSED NEW WORKS

(defun c:layN (/ suff i ss ent Nme Obj nNme)

(vl-load-com)

(setq suff "_N") ;; Layer Suffix

 

(setq lay (vla-get-Layers

(vla-get-ActiveDocument

(vlax-get-acad-object))))

(if (setq i -1 ss (ssget "_:L"))

(while (setq ent (ssname ss (setq i (1+ i))))

(setq Nme (cdr (assoc 8 (entget ent)))

Obj (vlax-ename->vla-object ent))

 

(cond ((and (= 14 (strlen Nme))(wcmatch Nme "[ACELMNS ]-*"))

(if (tblsearch "LAYER" (setq nNme (strcat Nme suff)))

(vla-put-layer Obj nNme)

(vla-put-Name (vla-item lay Nme) nNme)))

 

((and(

(setq nNme (strcat (substr Nme 1 14) suff))

(if (tblsearch "LAYER" nNme)

(vla-put-layer Obj nNme)

(progn

(vla-put-color (vla-add lay nNme) acMagenta)

(vla-put-Layer Obj nNme))))

(t (princ

(strcat "\n** Layer: " Nme " is not a Standard Format"))))))

(princ))

;EXISTING/APPROVED TO BE DEMOLISHED

(defun c:layR (/ suff i ss ent Nme Obj nNme)

(vl-load-com)

(setq suff "_R") ;; Layer Suffix

 

(setq lay (vla-get-Layers

(vla-get-ActiveDocument

(vlax-get-acad-object))))

(if (setq i -1 ss (ssget "_:L"))

(while (setq ent (ssname ss (setq i (1+ i))))

(setq Nme (cdr (assoc 8 (entget ent)))

Obj (vlax-ename->vla-object ent))

 

(cond ((and (= 14 (strlen Nme))(wcmatch Nme "[ACELMNS ]-*"))

(if (tblsearch "LAYER" (setq nNme (strcat Nme suff)))

(vla-put-layer Obj nNme)

(vla-put-Name (vla-item lay Nme) nNme)))

 

((and(

(setq nNme (strcat (substr Nme 1 14) suff))

(if (tblsearch "LAYER" nNme)

(vla-put-layer Obj nNme)

(progn

(vla-put-color (vla-add lay nNme) acyellow)

(vla-put-Layer Obj nNme))))

(t (princ

(strcat "\n** Layer: " Nme " is not a Standard Format"))))))

(princ))

 

 

 

Hi

My intension is to use in amendment or A&A projects.

One problem for me

Let say I have 3 objs in A-_MISC----_E- (Standard Layer) and then I want to change one obj to A-_MISC----_E-_N but when I select even one obj the whole standard layer(ALl 3 objs) change to new layer.

Actually I still want to keep the other two in standard layer.

Please help.

Thanks a lot

 

Kalarpu