LISP routine needed

Hi guys.

I need a LISP routine to do the following:

1) Explode the drawing (one time only),

2) Annotate first block name,

3) Explode this block (it becames a 3D object),

4) Put this 3D object in a layer with the same name of the block,

5) Do 2-4 for all the blocks

You can see the annexed file that contains a typical drawing on which I would like to execute the routine.

Thanks.

example.dwg

Edited December 1, 2016 by gigi7@iol.it

Have you tried coding anything yourself this would be the steps. Google the red.

 

explode first

use ssget to make a selection of all blocks

use repeat to go through selection,

get block name,

make layer block name,

explode block,

chprop to layer block name

end repeat all done.

Hi Bigal,

it's not so simple. I've forgotten that it's possible to have identical blocks so make layer returns an error when it tries to make a layer that already exists.

Example.dwg was updated.

 

Have you tried coding anything yourself this would be the steps. Google the red.

 

explode first

use ssget to make a selection of all blocks

use repeat to go through selection,

get block name,

make layer block name,

explode block,

chprop to layer block name

end repeat all done.

example.dwg

If you use:

(command "_.-layer" "_make" "MyNewLayer" "")

There will be no problem if the layer already exists.

With Visual it will probably look like this:

(vl-load-com)
(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq LyrColl (vla-get-Layers acDoc))
(vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc)
(and
(vlax-map-collection LyrColl (function (lambda (x) (vla-put-Lock x :vlax-false))))
(setq SS (ssget "_X" (list (cons 0 "INSERT") (cons 2 "Total") (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))))
(vl-every 
	(function 
		(lambda (b)
			(and
				(vla-Add LyrColl (vla-get-EffectiveName b))
				(not (vla-put-Layer b (vla-get-EffectiveName b)))
			)
		)
	)
	(vlax-invoke (setq mb (vlax-ename->vla-object (ssname SS 0))) 'Explode)
)
(not (vla-Delete mb))
)
(vla-EndUndoMark acDoc)

Grrr,

thanks a lot. I loaded the code after it was inserted in a new file example.vlx.

Autocad returns "_appload example.vlx successfully loaded."

How can I execute it now?

 

With Visual it will probably look like this:

(vl-load-com)
(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq LyrColl (vla-get-Layers acDoc))
(vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc)
(and
(vlax-map-collection LyrColl (function (lambda (x) (vla-put-Lock x :vlax-false))))
(setq SS (ssget "_X" (list (cons 0 "INSERT") (cons 2 "Total") (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))))
(vl-every 
	(function 
		(lambda (b)
			(and
				(vla-Add LyrColl (vla-get-EffectiveName b))
				(not (vla-put-Layer b (vla-get-EffectiveName b)))
			)
		)
	)
	(vlax-invoke (setq mb (vlax-ename->vla-object (ssname SS 0))) 'Explode)
)
(not (vla-Delete mb))
)
(vla-EndUndoMark acDoc)

Simply wrap it like this (define it as a function):

[color="red"](defun C:MyCommandName ; change the function name to fit your needs I.e.: "C:MyExplode"
( / acDoc LyrColl SS mb ) ; localise the used variables (everything used with (setq) function)[/color]

(vl-load-com)
(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq LyrColl (vla-get-Layers acDoc))
(vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc)
(and
	(vlax-map-collection LyrColl (function (lambda (x) (vla-put-Lock x :vlax-false))))
	(setq SS (ssget "_X" (list (cons 0 "INSERT") (cons 2 "Total") (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))))
	(vl-every 
		(function 
			(lambda (b)
				(and
					(vla-Add LyrColl (vla-get-EffectiveName b))
					(not (vla-put-Layer b (vla-get-EffectiveName b)))
				)
			)
		)
		(vlax-invoke (setq mb (vlax-ename->vla-object (ssname SS 0))) 'Explode)
	)
	(not (vla-Delete mb))
)
(vla-EndUndoMark acDoc)

[color="red"]	(princ) ; exit cleanly
); defun C:MyCommandName[/color]

And save it as WhatEverNameYouWant.lsp.

Then use appload command, point to the file and press the "load" button.

Check the comments in the code with what name to call the routine, and how to change it.

Grrr I tried the code below.

It was loaded and the command works!

Now I have only one issue: routine works if initial block name is "total".

Could you modify it to work with every possible initial block name?

Edited December 2, 2016 by gigi7@iol.it

Grrr I tried the code below. It was loaded but the expld command returns an error (unknown command)

You just need to type expld after loading the .lsp file.

I'm not sure what you are doing wrong, so you might want to check this tutorial.

 

Grrr I tried the code below.

It was loaded and the command works!

Now I have only one issue: routine works if initial block name is "total".

Could you modify it to work with every possible initial block name?

 

Do you wan't to fill in the code the blocknames? or type them in the input, or ignore the blocknames at all?

Note that the code currently expects that all objects after exploding the main block to be also blocks.

Edited December 2, 2016 by Grrr

You just need to type expld after loading the .lsp file.

I'm not sure what you are doing wrong, so you might want to check this tutorial.

Grrr, don't care about it, I did a mistake.

 

 

Do you wan't to fill in the code the blocknames? or type them in the input, or ignore the blocknames at all?

Note that the code currently expects that all objects after exploding the main block to be also blocks.

Grrr the example.dwg file has several 3D objects each nested in a different block all nested in a block named total. If this block has a name different from total the routine skips all the expected operations. May you modify the routine to prevent this?

Thanks!

102110118

Gigi7 as per my initial thoughts on this manually Explode the 1st "dwg" block then run Grr routine so it only has to work on individual blocks rather than a nested block.

Grrr the example.dwg file has several 3D objects each nested in a different block all nested in a block named total. If this block has a name different from total the routine skips all the expected operations. May you modify the routine to prevent this?

Thanks!

102110118

Try this:

 

(defun C:test ( / *error* acDoc LyrColl Lst )
(defun *error* (m) (and sUndo (vla-EndUndoMark acDoc)) (and m (alert m)) (princ))
(and
	vlax-get-acad-object
	(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
	(setq LyrColl (vla-get-Layers acDoc))
	(setq sUndo (not (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))))
	(vlax-map-collection LyrColl (function (lambda (x) (vla-put-Lock x :vlax-false))))
	(mapcar
		(function 
			(lambda (o)
				(mapcar
					(function 
						(lambda (b)
							(and
								(eq (vla-get-ObjectName b) "AcDbBlockReference")
								(vla-Add LyrColl (vla-get-EffectiveName b))
								(not (vla-put-Layer b (vla-get-EffectiveName b)))
							)
						)
					)
					(vlax-invoke o 'Explode)
				)
			)
		)
		(
			(lambda (s / i)
				(if (eq 'PICKSET (type s))
					(repeat (setq i (sslength s))
						(setq Lst (cons (vlax-ename->vla-object (ssname s (setq i (1- i)))) Lst))
					)
				)
			)
			(ssget "_X" (list (cons 0 "INSERT") (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model"))))
		)
	)
); and
(and Lst (mapcar 'vla-Delete Lst))
(and sUndo (vla-EndUndoMark acDoc))
(princ)
);| defun |; (vl-load-com) (princ)

I'll try it on Monday. Thanks!

255

It works perfectly! Thanks Grrr!

It works perfectly! Thanks Grrr!

 

Good to hear.

I had additional thought after posting my last code here, why won't iterate thru the block definitions and create the layers that way.

I think it would be faster if you want new layer name for every block name.

Your code seems to be very fast by now for my application but, if you think it's better to upgrade it, I agree.

 

Good to hear.

I had additional thought after posting my last code here, why won't iterate thru the block definitions and create the layers that way.

I think it would be faster if you want new layer name for every block name.

 

69

If you want new layer for every block name:

(defun C:test ( / bd bn )
(while (setq bd (tblnext "BLOCK" (null bd)))
	(and
		(not (wcmatch (cdr (setq bn (assoc 2 bd))) "`*U*,_*"))
		(entmakex
			(list
				(cons 0 "LAYER")
				(cons 100 "AcDbSymbolTableRecord")
				(cons 100 "AcDbLayerTableRecord")
				bn
				(cons 70 0)
			)
		)
	)
)
(princ)
)

It ignores anonymous block definitions, and the AutoCAD's built-in arrowhead blocks.