Topic: Weekend challenge

[Mark]

I have a weekend challenge for anyone who wants one. Create a separate dwg for each layer in the dwg that contains all those entities on that layer. An option for paperspace/modelspace entities only is a bonus.

Example:

Code: [Select]


create a list of layers.
iterate through each item in the list creating a sset of entities on that layer.
create a new dwg and insert those entities into it.
save dwg as name of layer
repeat...


[Jeff_M]

Hmmm.....weekend challenge. Does that mean you don't want a reply until Monday? This sounds like fun, but I won't be around much over the weekend and I'll be driving down to Calif. on Monday.

I have a solution for MS entities only. Incorporating an unlimited number of layout tabs could be a daunting task for little or no purpose.....

[Mark]

Then go with the MS entities only it doesn't matter, as long as we have fun!!

Drive carefully Jeff.

[Mark]

BTW, Monday is fine. I suspect someone will have a solution before then though.

[Jeff_M]

BTW, Monday is fine. I suspect someone will have a solution before then though.

Actually, I was wanting(hoping) to know if I could post it, like, now??

[Mark]

Go for it Jeff ..........

[Jeff_M]

OK, here goes. I just ran it on a real drawing (opposed to my test drawings) that had 6400 entites on 115 layers. I got 115 new drawings in under 8 seconds......

Of course my formatting isn't as 'pretty' as some people's here, but I don't think the lisp interpreter knows that

Code: [Select]


;| Routine to take an entire drawing's Modelspace and create new, smaller,
   drawings made up of the individual layers. Each new drawing is placed into
   a folder below the original drawing's path called "Layer-split" and saved
   with the name of the layer it contains.
   ObjectDBX MUST be registered on the computer running this (only applicable to
   versions prior to 2004)
   copyright Jeff Mishler and theSwamp.org - April 8, 2005
   author may be reached via email at jeff_m@cadvault.com
   version 0.10 - initial build - NO error handling in place
|;  
(defun c:layers2dwgs (/       ans dbxstring  dwg
     entlist  frozen idx layer  layers
     locked   odbx path ss  tmpltpath
     wason
    )
  (vl-load-com)
  ;;first, we need to know what version we are using
  (if (< (atoi (getvar "ACADVER")) 16)
    (setq dbxString "ObjectDBX.AxDbDocument")
    (setq dbxString "ObjectDBX.AxDbDocument.16")
  )
  ;;get the location of Autocad's template drawing
  (setq tmpltPath (vla-get-TemplateDWGPath
   (vla-get-files
     (vla-get-preferences
(vlax-get-acad-object)
     )
   )
 )
  )
  ;;now let's get info about the current drawing
  (setq dwg  (vla-get-activedocument (vlax-get-acad-object))
path (strcat (vla-get-path dwg) "\\Layer-split")
oDBX (vla-getinterfaceobject (vlax-get-acad-object) dbxString)
  )
  ;; later we'll create a path below the drawings'
  ;; check if the path already exists
  (if (vl-file-directory-p path)
    (progn
      ;;yep, do we want to replace it
      (initget "Yes No")
      (setq ans (getkword
 "\n....sub-Folder already exists, replace? Y or N: "
)
      )
      (if (eq ans "Yes")
(progn ;;yep, so delete it
      (vl-rmdir path)
      (setq ans nil)
)
      )
    )
  )
  ;; now, if the symbol ans is nil then we continue on, if the user answered No to replacing
  ;; the folder we will just exit quietly with doing anything
  (if (not ans)
    (progn
      (vl-mkdir path)
      ;;create the path
      (setq layers (vla-get-layers dwg)) ;get the layers
      (vlax-for lay layers
;;loop thru the layers
;;check the layer's status of locked, frozen and off....
;; we don't want it to be any of them
(setq Locked (vla-get-lock lay)
     Frozen (vla-get-freeze lay)
     wasOn  (vla-get-layeron lay)
)
(if (eq locked :vlax-true)
 (vla-put-lock lay :vlax-false)
)
(if (and (/= (vla-get-name lay) (getvar "clayer"))
(eq frozen :vlax-true)
   )
 (vla-put-freeze lay :vlax-false)
)
(if (eq wasOn :vlax-false)
 (vla-put-layeron lay :vlax-true)
)
(if (setq ss
  (ssget "x" (list (cons 8 (vla-get-name lay)) '(67 . 0)))
   )
;;collect all entities in MS on subject layer
 (progn
   (setq idx -1
 entList nil
   )
   ;;re-initialize symbols
   (while (< (setq idx (1+ idx)) (sslength ss))
     (setq
entList (cons (vlax-ename->vla-object (ssname ss idx))
     entlist
)
     )
   )
   ;;create a list of all objects on the layer
   (vla-open oDBX (strcat tmpltPath "\\acad.dwt"))
   ;;use the default drawing template for new drawings
   (vlax-invoke
     dwg
     'copyobjects
     entlist
     (vla-get-modelspace oDBX)
     'idpairs
   )
   ;; use copyobjects to place in the new drawing's modelspace
   (vla-saveas
     oDBX
     (strcat path "\\" (vla-get-name lay) ".dwg")
   )
   ;;now save it with the layer name
 )
)
;; restore the lock, frozen off status
(if (eq locked :vlax-true)
 (vla-put-lock lay :vlax-true)
)
(if (and (/= (vla-get-name lay) (getvar "clayer"))
(eq frozen :vlax-true)
   )
 (vla-put-freeze lay :vlax-true)
)
(if (eq wasOn :vlax-false)
 (vla-put-layeron lay :vlax-false)
)
      )
    )
    (princ "\nFolder exists...nothing done.")
  )
  ;;we're done with oDBX
  (vlax-release-object oDBX)
  (princ)
  ;;exit quietly
)

;;toolbox function
;;remove directory...will remove whether it contains files or not
(defun vl-rmdir (path / fso)
  (setq fso (vla-getinterfaceobject
     (vlax-get-acad-object)
     "Scripting.FileSystemObject"
   )
  )
  (vlax-invoke fso 'deletefolder path 0)
  (vlax-release-object fso)
)


[nivuahc]

wow

[nivuahc]

seriously.


wow.

[Kerry]

That avatar SO matches that comment

[TR]

(vl-load-com)

Just use VBA, at least people can read it then.  

[Kerry]

*cough*

[nivuahc]

That avatar SO matches that comment

Ask Mark how closely it resembles me in real life

[Jeff_M]

(vl-load-com)

Just use VBA, at least people can read it then.  

Well, had Mark posted the challenge in the VBA forum rather than the lisp forum, I very well may have

[TR]

I was kidding.

[Jimmy D]

Not so fancy as Jeff_M ... but it works.

Code: [Select]

(defun c:LayToDwg (/ LayName)
(setq DwgPath (getvar "DWGPREFIX")
      PO (list 0 0 0))
(defun NewDwg (LayName / DwgPathName)
   (setvar "CLAYER" LayName)
   (command "_layer" "freeze" "*" "")
   (setq DwgPathName (strcat DwgPath LayName))
   (command "_WBlock" DwgPathName "" P0 "all" "")
   (command "OOPS")
   (command "_layer" "thaw" "*" "")
)
(setq LayName (cdr (assoc 2 (tblnext "layer" T))))
(NewDwg LayName)
(while (/= (setq LayName (cdr (assoc 2 (tblnext "LAYER")))) nil)
       (NewDwg LayName))
(command "regen")
)

And this was all done on a Monday morning!

Jimmy

[daron]

Jimmy, how many drawings were created? How many entities were present? How long did it take? I'm curious to see how big of a file it would take to render that code useless? I'll llink as to my questioning why momentarily. Stay tuned...

This
and
this
and
this

[Jimmy D]

Daron,

You're right about the time it takes.
I've tried it on a +7Mb drawing with +30500 objects in it, and it took about 35 secs (didn't really time it), but it did what it was suppose to do. All dwg's were created (25 layers - 25 dwg's).
I know there is a right and a wrong way to do things, but if I knew the right way, I wouldn't be reading this forum would I?
I'm new at this and I'm figuring it out as I go along!

Jimmy

[nivuahc]

I know there is a right and a wrong way to do things, but if I knew the right way, I wouldn't be reading this forum would I?

Yes, that's true...

It works = right way
It doesn't work = wrong way

What you wrote works. Don't think, for one second, that it is in any way wrong. Is there a better way? There almost always is... no matter what you're talking about. What you did works, so it's right. Period. I don't care who you are or what code you write... code can always be improved. That doesn't make it wrong.

I'm new at this and I'm figuring it out as I go along!

Based on the code you posted above, I would think that it is your duty to drop the "I'm new at this" bit... I know people who have been writing code for a long, long time who wouldn't have been able to come up with that on a Monday morning. If you truly are *new* at this, you are far more advanced than a lot of people I know. You're being too hard on yourself Jimmy.  

[Jimmy D]

Thanks Nivuahc. When I say I'm *new* I mean I've only been programming lisp for about a year now, so *new* is relative.

I'm jealous how you guys can program so clearly and simple though.
My biggest problem I think is that I write too impulsive and make everything up as I go along. All my programs look very messy and after a while I can't even find my way in it. But sooner or later I'll get there...

[nivuahc]

All my programs look very messy and after a while I can't even find my way in it. But sooner or later I'll get there...

Sounds like you have my programming style down to a T.

And I've been doing it for about 15 years.

[SMadsen]

Is there any other style??

[CAB]

   

[TR]

Pfft..every program I've ever written looks as if it came straight from the hands of Zeus.


But seriously if you're not a professional programmer and/or you're not programming every day then chances are you're code isn't going to be the best looking stuff around. I have to agree with Chuck on this that as long as it works as intended you should be happy. Then in five years when you're a better programmer you can go back and tweak that while loop to save you 3 milliseconds in execution time.

[ronjonp]

Hey Jeff,

I get this when I tried your routine:

Code: [Select]

Command: layers2dwgs
; error: Automation Error. Description was not provided.

What am I doing wrong?

Thanks,

Ron

[daron]

Daron,
...I know there is a right and a wrong way to do things, but if I knew the right way, I wouldn't be reading this forum would I?
I'm new at this and I'm figuring it out as I go along!

Jimmy

Jimmy, the reason I would bring this out isn't to point out that you've done anything wrong. Did I say it was wrong? I don't think so. If I did, I apologize. Why I would bring up what I did, would be to help you learn. This place is about learning and I, as well as many others here are here to both learn from each other and to help others learn. To be perfectly honest, my first year stuff has a lot of bad programming examples. I didn't get beyond it until about five years later when I started visiting sites like this. Your lucky you found them in your first year. You'll learn a lot from this place. I hope when you do, you won't go away, but will contribute to the atmosphere of this place. We can never have too many good people here.

[Jeff_M]

Jimmy, that is a quick and simple approach which met the requirements. Well done. I will say this, though.....using wblock will allow any and all named layer filters in the original drawing to be copied to all of the new drawings, at least in R2002 and below.

Ron, good question. That error will occur when calling for an item in a collection (usually) that doesn't exist. If you could open the code in the VLIDE, set a break point near the beginning, step through the code while it's running and note at what line it errors I may be able to figure it out

Has anyone else with 2005 tried this?

[Water Bear]

yep..i got the same thing  

the LayToDwg routine sets the layer current, then attempts to freeze it..which generates an error on that, and subsequently every command in the loop....

[Jeff_M]

OK, I guess I'll go back and add a ton of error checking with different messages for each one so I can see where it's breaking. I suspect, though, that it is the ObjectDBX reference......and since I only have 2002 to test on, I'm not sure what the newer version nimbers are.

[Jimmy D]

Did I say it was wrong? I don't think so. If I did, I apologize.

Absolutely no need to apologize and no offence was taken.
Maybe I sounded at little angry but I'm not.
I'm glad that guys like you try to show me the correct way.

[MP]

OK, I guess I'll go back and add a ton of error checking with different messages for each one so I can see where it's breaking. I suspect, though, that it is the ObjectDBX reference......and since I only have 2002 to test on, I'm not sure what the newer version nimbers are.

Hi Jeff. The

Command: layers2dwgs
; error: Automation Error. Description was not provided.

error can often be thrown when calling activex methods on custom objects when the associated arx libraries aren't loaded up. For example, trying to process a Rebis Civil / Structural model from a vanilla session. What one has to do before processing entities like this is to first do a sweep of the drawing (sometimes a dictionary scan will suffice) and determine if any additional arx libraries are required and load 'em up. This can be especially challenging if you receive files from third parties w/out the benefit of the arx files used to create them (zombie processing).

No doubt there are other sitiations that will throw this error but I know this to be one of them.

Sorry if this wasn't entirely coherent, I need, and yet don't yet have a big ol' cup of coffee in front of me.