Creating layers by selecting objects

[Lee Mac]

Thats not LISP, just what you can do with the command

 

Here is a much faster version of the LISP that FreeRefill wrote

 

(defun c:ftoo (/ lays lLst i ss ent obj nl)
 (vl-load-com)
 (setq lays (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))

 (if (setq i -1 ss (ssget "_:L" '((8 . "* - FUTURE"))))    
   (while (setq ent (ssname ss (setq i (1+ i))))
     (setq l (vla-get-Layer (setq obj (vlax-ename->vla-object ent))))
     
     (or (tblsearch "LAYER" (setq nl (substr l 1 (- (strlen l) 9)))) (vla-add lays nl))
     (vla-put-layer obj nl)))

 (princ))

[Archiman86]

Wow, that works great. Is there a faster way for the first command he wrote as well. It seems to go kind of slow when I selct 100's of objects. Maybe I am being too greedy. Thanks in advance!

[Lee Mac]

You mean the "obtol" routine?

[Archiman86]

yes, that one seems to take some time as well, if I select a large number of objects. If not, its no big deal. Like I said, it works, thats whats most important.

[Lee Mac]

yes, that one seems to take some time as well, if I select a large number of objects. If not, its no big deal. Like I said, it works, thats whats most important.

 

Its due to the way Freerefil converts the SelectionSet into a list, and also using the command calls - both are extremely slow methods... along with the numerous calls to vlax-get-acad-object - which is very bad practice.

 

But I shall see what I can do when I get a minute

[Lee Mac]

Give this a go;

 

(defun c:obtol (/ lays i ss ent l obj nl)
 (vl-load-com)

 (setq lays (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 l (vla-get-layer (setq obj (vlax-ename->vla-object ent))))

     (or (tblsearch "LAYER" (setq nl (strcat l " - FUTURE"))) (vla-add lays nl))
     (vla-put-layer obj nl)))
 
 (princ))

[Archiman86]

Thanks a lot for the quick response. One problem that we ran into before is the fact that if the layer already exists, I dont want it to make another one with the suffix "- FUTURE - FUTURE". This seems to happen...

[Lee Mac]

Sorry, I was just following the code in the first page... will modify it for you

[Lee Mac]

(defun c:obtol (/ lays i ss ent l obj nl)
 (vl-load-com)

 (setq lays (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 l (vla-get-layer (setq obj (vlax-ename->vla-object ent))))

     (and (not (wcmatch l "* - FUTURE"))
          (or (tblsearch "LAYER" (setq nl (strcat l " - FUTURE"))) (vla-add lays nl))
          (vla-put-layer obj nl))))
 
 (princ))

[Archiman86]

That works great! Thank you soo much. I really appreciate it. You truly are a MASTER!

 

Regards.

[Lee Mac]

That works great! Thank you soo much. I really appreciate it. You truly are a MASTER!

 

Regards.

 

Many thanks

 

Lee

[Archiman86]

Lee,

 

Is there a way to incorporate this into your faster version? I just noticed that it does not add these properties after creating the layer. (works great otherwise)

 

That works great thanks. Now is there a way to set the properties for the layer when it creates it. Namely I would like to set the color to 252 and the linetype to "hidden"

 

Thanks again!

[Lee Mac]

Lee,

 

Is there a way to incorporate this into your faster version? I just noticed that it does not add these properties after creating the layer. (works great otherwise)

 

Try this:

 

(defun c:obtol (/ lays i ss ent l obj nl)
 (vl-load-com)

 (setq lays (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 l (vla-get-layer (setq obj (vlax-ename->vla-object ent))))

     (and (not (wcmatch l "* - FUTURE"))
          (or (tblsearch "LAYER" (setq nl (strcat l " - FUTURE")))
              (and (setq nlay (vla-add lays nl))
                   (mapcar
                     (function
                       (lambda (property value)
                         (vlax-put-property nlay property value))) '(Linetype Color) '("HIDDEN" 252))))
              
          (vla-put-layer obj nl))))
 
 (princ))

[Archiman86]

Great, that is EXACTLY what I needed. Thanks Again.

[Lee Mac]

You're welcome

[ronjonp]

Lee,

 

You could make it even faster by filtering out the objects already on a future layer like so:

 

(ssget "_:L" '((8 . "~* - FUTURE")))

 

[Lee Mac]

Nice idea Ron!

 

(defun c:obtol (/ lays i ss ent l obj nl)
 (vl-load-com)

 (setq lays (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object))))

 (if (setq i -1 ss (ssget "_:L" '((8 . "~* - FUTURE"))))
   (while (setq ent (ssname ss (setq i (1+ i))))
     (setq l (vla-get-layer (setq obj (vlax-ename->vla-object ent))))

     (or (tblsearch "LAYER" (setq nl (strcat l " - FUTURE")))
         (and (setq nlay (vla-add lays nl))
              (mapcar
                (function
                  (lambda (property value)
                    (vlax-put-property nlay property value))) '(Linetype Color) '("HIDDEN" 252))))

     (vla-put-layer obj nl)))
 
 (princ))

[ronjonp]

Speed difference is probably minimal....but just another way to skin the cat.