Layer Lisp

[alanjt]

so, you want one that moves selected objects to a cloned layer suffixed with "_N", or are you wanting the written routine modified to do this?

[kalarpu]

Please modify

Thanks

 

Kalarpu

[Lee Mac]

Please modify

Thanks

 

Kalarpu

 

Kalarpu - there is no need for three copies of the same LISP, with the only difference being the suffix - just make one sub-function, with the suffix as the argument and call it as needed. :wink:

[kalarpu]

I have no idea because I am just start learning.

Please guide me

Thanks

[Lee Mac]

I have no idea because I am just start learning.

Please guide me

Thanks

 

Not a problem,

 

I meant like this:

 

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

(defun lays  (suff / i ss ent Nme Obj nNme)
 (vl-load-com)
 (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 (< 14 (strlen Nme)) (wcmatch Nme "[ACELMNS ]-*"))
            (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))

(defun c:layO ( )
 (lays "")
 (princ))

(defun c:layE ( )
 (lays "_E")
 (princ))

(defun c:layN ( )
 (lays "_N")
 (princ))

(defun c:layR ( )
 (lays "_R")
 (princ))

I have made the suffix an argument and have called the sub-function "lays" each time.

 

Lee

[kalarpu]

Hi Lee Mac

Please check this "(setq nNme (strcat Nme suff))"

Because I think it changed(renamed) my standard layer to 14_N or 14_E or 14_R even I selected only one obj (the rest I still want to remain in standard layer).

I prefer to create newlayer base on standard not for just rename.

Thanks for your help

[Lee Mac]

At the moment the LISP is checking to see if "14_E" exists, and, if it does it will move the object to it, else it will rename the layer to "14_E", are you saying that instead of renaming, to create a new layer and move the object to this new layer?

[kalarpu]

Yes, please create new layer instead of renaming because I just want to move the selected obj only to new layer so that other objs still remain in old layer

Thanks

[Lee Mac]

How about this:

 

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

(defun lays  (suff / i ss ent Nme Obj nNme)
 (vl-load-com)
 (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)
              (progn
                (vla-add lay nNme)
                (vla-put-Layer Obj nNme))))

           ((and (< 14 (strlen Nme)) (wcmatch Nme "[ACELMNS ]-*"))
            (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))

(defun c:layO ( )
 (lays "")
 (princ))

(defun c:layE ( )
 (lays "_E")
 (princ))

(defun c:layN ( )
 (lays "_N")
 (princ))

(defun c:layR ( )
 (lays "_R")
 (princ))

[kalarpu]

Great

You are the man!

Thanks a lot

[Lee Mac]

Not a problem

[kalarpu]

Hi

When I use refedit in place, all layer changed to $-$14 and cannot use lisp already.Please help

[JeepMaster]

Is it possible to modify the lisp that you guys have here so that all the layers on the drawing will have "-DD" added on the end? It seems very close to be able to do it, but I can't figure it out.

ie: E-POWR-TEXT to E-POWR-TEXT-DD

[Lee Mac]

The lazy man's way:

 

(defun c:laysuff (/ suff doc)
 (vl-load-com)

 (while (not (and (setq suff (getstring "\nSpecify Suff for all Layers: "))
                  (snvalid suff)))
   (princ "\n** Invalid Suffix **"))

 (vla-StartUndoMark (setq doc (vla-get-ActiveDocument
                                (vlax-get-acad-object))))

 (vlax-for lay (vla-get-layers doc)
    (vl-catch-all-apply 'vla-put-Name
      (list lay (strcat (vla-get-Name lay) suff))))

 (vla-EndUndoMark doc)
 (princ))

[JeepMaster]

It works perfectly. Thanks LeeMac for your help as usual.

 

How hard is it to remove suffix? so instead of vla-put-name, vla-remove-name? Sorry I don't know any VLA commands.

[Lee Mac]

Haha, no such function I am afraid... we have to approach things differently

 

(defun c:RemSuff (/ suff doc)
 (vl-load-com)

 (while (not (and (setq suff (getstring "\nSpecify Suff to Remove: "))
                  (snvalid suff)))
   (princ "\n** Invalid Suffix **"))

 (vla-StartUndoMark (setq doc (vla-get-ActiveDocument
                                (vlax-get-acad-object))))

 (vlax-for lay (vla-get-layers doc)
    (vl-catch-all-apply 'vla-put-Name
      (list lay (vl-string-right-trim suff (vla-get-Name lay)))))

 (vla-EndUndoMark doc)
 (princ))

[alanjt]

You could do something like this and it wouldn't add the suffix if said suffix already existed. (ie: Lay would become Lay-DD, but Fun-DD would be left as is)

 

(defun c:laysuff (/ suff doc)
 (vl-load-com)

 (while (not (and (setq suff (getstring "\nSpecify Suff for all Layers: "))
                  (snvalid suff)))
   (princ "\n** Invalid Suffix **"))

 (vla-StartUndoMark (setq doc (vla-get-ActiveDocument
                                (vlax-get-acad-object))))

 (vlax-for lay (vla-get-layers doc)
   (or (wcmatch (strcase (vla-get-name lay)) (strcase (strcat "*" suff)))
    (vl-catch-all-apply 'vla-put-Name
      (list lay (strcat (vla-get-Name lay) suff)))))

 (vla-EndUndoMark doc)
 (princ))

[Lee Mac]

Nice idea Alan - hadn't thought of it... but then I did say "lazy man's way"...

[JeepMaster]

Wow, LeeMac that is awsome stuff. Thanks for the super quick response.

 

I'm running into a little problem. If only some of my layers have the suffix I wish to remove, it doesn't seem to work.

ie: I have many layers with -NEWW and -EXST. And I want to remove all the -EXST from those layers.

 

Maybe it needs to have a search function to replace those layers only.

[JeepMaster]

You could do something like this and it wouldn't add the suffix if said suffix already existed. (ie: Lay would become Lay-DD, but Fun-DD would be left as is)

 

(defun c:laysuff (/ suff doc)
 (vl-load-com)

 (while (not (and (setq suff (getstring "\nSpecify Suff for all Layers: "))
                  (snvalid suff)))
   (princ "\n** Invalid Suffix **"))

 (vla-StartUndoMark (setq doc (vla-get-ActiveDocument
                                (vlax-get-acad-object))))

 (vlax-for lay (vla-get-layers doc)
   (or (wcmatch (strcase (vla-get-name lay)) (strcase (strcat "*" suff)))
    (vl-catch-all-apply 'vla-put-Name
      (list lay (strcat (vla-get-Name lay) suff)))))

 (vla-EndUndoMark doc)
 (princ))

 

Thanks Alan. I didn't pick that one up untill I recheck all my layers. Thanks so much.