Topic: Help me speed up existing routine to move objects from Layer 0

[cmwade77]

We quite often recieve drawings that have a lot of stuff drawn on layer 0. (Sometimes the entire drawing  :realmad:) Unfortunately we have to xref these files and need to be able to turn things off, I have come up with a LISP routine that does this:

Code: [Select]

(defun lay0s ()
(princ "\n*** Moving all items on Layer 0 to new layers ***\n")
(setq EN1 (ssget "X" '((8 . "0"))))
(cond
((/= EN1 nil)
(setq JJ  (sslength EN1))
(SETQ EN2 0)
(WHILE (< EN2 JJ)
(setq ED (entget (ssname EN1 EN2)))                        
(SETQ D (cdr (assoc 2 ED))
     E (cdr (assoc 0 ED))
 F (cdr (assoc 5 ED)))  
(if (= D nil)
(setq D "Misc")
)
(if (= E nil)
(setq E "MiscTyp")
)
(if (= F nil)
(setq F "MiscOb")
)
(SETQ D (STRCAT "WAS0 - " D "-" E "-" F))
(SETQ D (DOS_STRREPLACE D ":" "$"))
(SETQ D (DOS_STRREPLACE D ";" "$"))
(SETQ D (DOS_STRREPLACE D "*" "$"))
(SETQ D (DOS_STRREPLACE D "?" "$"))
(SETQ D (DOS_STRREPLACE D "," "$"))
(SETQ D (DOS_STRREPLACE D "<" "$"))
(SETQ D (DOS_STRREPLACE D ">" "$"))
(SETQ D (DOS_STRREPLACE D "/" "$"))
(SETQ D (DOS_STRREPLACE D "\\" "$"))
(SETQ D (DOS_STRREPLACE D "|" "$"))
(SETQ D (DOS_STRREPLACE D ">" "$"))
(SETQ D (DOS_STRREPLACE D "." "$"))
(SETQ D (DOS_STRREPLACE D ":" "$"))
(command "-layer" "m" D "set" "0" "")
(SETQ ED (SUBST (CONS 8 D) (ASSOC 8 ED) ED))
(ENTMOD ED)  
(SETQ EN2 (+ EN2 1))
) ;end WHILE entities
)
)
(princ "\n*** Done moving all items on layer 0 to new layers ***\n")
)The problem with this routine is that it is a bit on the slow side and I know that there are many here that know more than I and I am wondering what can be done that might be able to speed it up? I would greatly appreciate any and all suggestions.

[Lee Mac]

I don't use DosLib, so I haven't included all the string replacement, but this may be faster for you:

Code: [Select]

(defun Lay0s ( / _Layer i ss e el d e f l )

  (defun _Layer ( Name )
    (entmake
      (list
        (cons 0 "LAYER")
        (cons 100 "AcDbSymbolTableRecord")
        (cons 100 "AcDbLayerTableRecord")
        (cons 2 Name)
        (cons 70 0)
      )
    )
  )
 
  (if (setq i -1 ss (ssget "_X" '((8 . "0"))))

    (while (setq e (ssname ss (setq i (1+ i)))) (setq el (entget e))

      (setq d (cond ( (cdr (assoc 2 el)) ) ("Misc"))
            e (cond ( (cdr (assoc 0 el)) ) ("MiscTyp"))
            f (cond ( (cdr (assoc 5 el)) ) ("MiscOb"))
      )
      (_Layer (setq l (strcat "WAS0 - " d "-" e "-" f)))

      (entmod (subst (cons 8 l) (assoc 8 el) el))
    )
  )

  (princ)
)

[JohnK]

What do you mean by `Challenge'? Do mean to get several people to do this for you so that you can pick the best one or do you mean that you are challenged by this problem. If the later, then there is no need to state that because its obvious by your asking the question.

[JohnK]

sorry, im crabby i guess. never mind me. I will leave this apology (and the other) for a while and i will delete my two posts in this thread.

[T.Willey]

<snip>  I will leave this apology (and the other) for a while and i will delete my two posts in this thread.

I don't think you should se7en.

[roy_043]

@ Lee:
I notice that you specifically create each new layer. I always thought that entmod and entmake automatically create layers that do not exist. Or has this changed in AutoCAD?

[Lee Mac]

@ Lee:
I notice that you specifically create each new layer. I always thought that entmod and entmake automatically create layers that do not exist. Or has this changed in AutoCAD?

I know that entmake does, but I wasn't sure if entmod did too... I shall investigate... 

[MP]

@ Lee:
I notice that you specifically create each new layer. I always thought that entmod and entmake automatically create layers that do not exist.

You have to be careful with that -- in some circumstances it will cause AutoCAD to go fatal. Can't remember the specifics, sorry, but I do remember it happening to me, and accordingly, I stopped the practice.

[Lee Mac]

You're right - it appears it does - well, that makes my code a lot simpler 

...EDIT: judgin by MP's post, not sure now...

[cmwade77]

What do you mean by `Challenge'? Do mean to get several people to do this for you so that you can pick the best one or do you mean that you are challenged by this problem. If the later, then there is no need to state that because its obvious by your asking the question.

I modified the subject to make it clearer, sorry.

[cmwade77]

I don't use DosLib, so I haven't included all the string replacement, but this may be faster for you:

Thank you Lee, I used to use DosLib as a shortcut before I knew as much, I am still trying to get rid of my code that uses it whenever I can, there are a couple of items that it's still handy for though, but this is not one of them, I didn't even notice that I was still using it.

[JohnK]

<snip>  I will leave this apology (and the other) for a while and i will delete my two posts in this thread.

I don't think you should se7en.

okay, i'll leave it.

[JohnK]

What do you mean by `Challenge'? Do mean to get several people to do this for you so that you can pick the best one or do you mean that you are challenged by this problem. If the later, then there is no need to state that because its obvious by your asking the question.

I modified the subject to make it clearer, sorry.

thank you.

[JohnK]

You're right - it appears it does - well, that makes my code a lot simpler 

...EDIT: judgin by MP's post, not sure now...

why did you remove the orig code? that would have been a good learning example.

[cmwade77]

Lee,

I have modified your code a bit:

Code: [Select]

; The following code was modified from code posted by Lee Mac at: http://www.theswamp.org/index.php?topic=35517.msg407350#msg407350
; This code was based of original code by Chris Wade
(defun Lay0s ( / i ss e el d e f )
  (if (setq i -1 ss (ssget "_X" '((8 . "0"))))
    (while (setq e (ssname ss (setq i (1+ i)))) (setq el (entget e))
      (setq d (cond ( (cdr (assoc 2 el)) ) ("Misc"))
            e (cond ( (cdr (assoc 0 el)) ) ("MiscTyp"))
            f (cond ( (cdr (assoc 5 el)) ) ("MiscOb"))
      )      
      (entmod (subst (cons 8 (vl-string-translate ":;*?,<>/\\|." "$$$$$$$$$$$" (strcat "WAS0 - " d "-" e "-" f))) (assoc 8 el) el))
    )
  )
  (princ)
)I am going to use this code with the new ScriptPro that was posted on AutoDesk labs today, which will simply resume if AutoCAD crashes, so I think that I can risk AutoCAD crashing. But looking into it, I think the conditions that caused CAD to crash with having entmod crash AutoCAD is if there are chracters in the layer name that are not valid, which is the reason for the vl-string-translate, so that it will remove any invalid characters from the layer name. I know I had problems with this when manually creating the layer using the layer command, which was the reason for the string substitution.

By the way this code is substantially faster:
700 Objects
Old code: 7 seconds
Code above: ~0.25 seconds

Thank you Lee