lisp to copy object inside block and write to separate drawing

[aces_acap]

greetings..

hye all, i need help to create new dwg files from multiple object in model space into separate drawing.

i received a native drawing from client with  a total of 7-800+ pages. i had already spent few weeks in modifying and compiling the drawing into separate pdf files. but then the client requested for a cad files for each dwg by end of this week. using wblock i started to do this manually but im not going to finish on time. i need help to automate this task if possible. what i had done is i placed each drawing inside a block with an attribute (which will be the new_cad_file name). the drawing/object are place inside block (but not a part of said block). i created a sample dwg for your kind attention.

[ВeekeeCZ]

Post input drawing and all desired output dwgs to clearly see what goes into the process and what's the desired outcome.

[ronjonp · Accepted solution]

Just guessing but give this a try. Very little error checking.

(defun c:foo (/ a ll n p s ur)
  ;; RJP » 2022-04-25
  (cond	((setq s (ssget '((0 . "INSERT") (2 . "BLOCK2DWG") (410 . "Model"))))
	 (setvar 'tilemode 1)
	 (setq p (strcat (getvar 'dwgprefix) "_ExportedBlocks\\"))
	 (vl-mkdir p)
	 (setvar 'cmdecho 0)
	 (foreach e (mapcar 'cadr (ssnamex s))
	   (vla-getboundingbox (vlax-ename->vla-object e) 'll 'ur)
	   (mapcar 'set '(ll ur) (mapcar 'vlax-safearray->list (list ll ur)))
	   (setq n (getpropertyvalue e "DWG.NO#"))
	   (command "_.Zoom" "_W" ll ur)
	   (cond ((and (setq a (ssget "_W" ll ur)) (> (sslength a) 1))
		  ;; (ssdel e a)
		  (command "_.-Wblock" (strcat p n ".dwg") "" '(0 0 0) a "")
		 )
	   )
	 )
	 (setvar 'cmdecho 1)
	 (alert p)
	)
  )
  (princ)
)

[aces_acap]

from the source drawing (new block.dwg) per attachment above, there are 3 blocks with different object inside. the block has different tag/attribute which named file_001, file_002, file_003. i need each of these block inside a new dwg..

named:

file_001.dwg

file_002.dwg

file_003.dwg

how i imagine it to work is like this

call command>select block/s (x-number of blocks with file name attribute)> then the program will run for (x-times) how many blocks there is to create according to prev. selection...

the output will be (for example):

file_1.dwg

.

.

file_x.dwg

see attachment

input file- new block.dwg

output file- file_001.dwg; file_002.dwg;

i had reach max attachment, but there should be last file name file_003.dwg as per input dwg..

so if i have 700 blocks with 700 file_name_attribute, i can select all/how many i wish to create different dwg file.

am i clear?

[aces_acap]

your lisp kind of working (with slight issues)

1) after export, it delete the content of master file (see attach pic untittled.png)

2) the last file_003 is missing the bounding box (see attach pic untittled2.png)

3) it missing the file_name at bottom right corner as per original (see attach pic untittled3.png)

also, i wish to select which block/how many i want to export using selection.

if i have 700-800 block, i might want to segregate the work into few batch in fear of program/pc crashing (performance issues).

however this much has greatly ease my work. thanks

[ronjonp]

@aces_acap 

Try the code above again. You can select items and it will keep the titleblock in the selection.

[pbejse · Accepted solution]

---

@aces_acap wrote:

file_001.dwg

file_002.dwg

file_003.dwg

---

Similar to @ronjonp's contribution , the difference is the lower left corner point will be at 0.0 0.0  on the exported files

(defun c:GetOut  ( / aDoc ss i ll ur ll data e objs TagFile WBMT)
(setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))   
(if
  (and
  	(= 1 (getvar 'Dwgtitled))
	(setq path (getvar 'dwgprefix))
  	(setq ss (ssget '((0 . "INSERT") (2 . "BLOCK2DWG"))))
  	)
  (progn
	(repeat (setq i (sslength ss))
	  (vla-getboundingbox
	    (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i))))) 'll 'ur
	    )
	   (setq data (mapcar 'vlax-safearray->list (list ll ur)))
	   (command "_.Zoom" "_W" "_non" (Car  data) "_non" (cadr data))
	   (if (and
	     	(setq TagFile (vl-some '(lambda (at)
				     (if (eq (vla-get-tagstring at) "DWG.NO#")
				       		(strcat path (vla-get-textstring at) ".dwg")))
				  		(vlax-invoke e 'GetAttributes)))
		(setq objs (ssget "_W" (Car data)(Cadr data)))
		)
	     	(progn
		  (setq WBMT (vla-get-activeselectionset aDoc))
		  (vlax-for capture WBMT
		    (vla-copy capture)
		    	(Vlax-invoke capture 'Move (car data) '(0.0 0.0 0.0)))
	          (vla-WBlock aDoc TagFile  WBMT)		    
		  (vlax-for txt WBMT(vla-delete txt))
	          (vla-delete WBMT)
		     )
		  )
	      )
	  )
  )
  (princ)
  )

HTH

[ronjonp]

@pbejse Very nice 😎

One small improvement since the rest of your code is commandless 🙂

[aces_acap]

this is just great..

will this work on any other drawing? do i need to replace anything to make it work with other drawing/ different attribute. let say inside my drawing, i have 2 different attribute_tag which will be use..

eg. the attribute for 1 st part is name_tag (file#_xxx) & for 2nd part is sheet_tag (sheet#_xxx)

thanks

[pbejse]

---

@aces_acap wrote:

... will this work on any other drawing? do i need to replace anything to make it work with other drawing/ different attribute. let say inside my drawing, i have 2 different attribute_tag which will be use..

eg. the attribute for 1 st part is name_tag (file#_xxx) & for 2nd part is sheet_tag (sheet#_xxx)

---

Yes it is possible, like before, post a sample drawing, and show the intended results please

[pbejse]

---

@ronjonp wrote:

@pbejse Very nice 😎

One small improvement since the rest of your code is commandless 🙂

---

Thank you for that @ronjonp.

Good catch 👍

[aces_acap]

this should do for my current work. maybe later i will explore more possibilities with them, might need your help then..

@ronjonp @pbejse @ВeekeeCZ kudos

[aces_acap]

hello @pbejse,@ronjonp , i need a bit of extra help here,

after we succesfully takeout all model object from model space, our client get back to us with new comments.

when our lisp created the new dwg. they open it at empty space which require them to do zoom extent (because the dwg. file initially zoom to base). since we have around 600 dwg. files this become frustrating to them. can u help to modify the lisp a bit so that. the newly created dwg automatically zoom to object(dwg) when open. and also they want a layout view for each new dwg (based on current layout page setup) .

[ronjonp]

After your files are created create a script to zoom extents for all drawings, process them then send to the client. AFAIK there is no 'fast' way to do this like ODBX.

[aces_acap]

is it...

ok., i just though the position can be modified in the previous lisp