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.