Lisp to preview all blocks in a drawing

Hi guys,

I'm working on this code to preview all blocks in a drawing, but theres a problem I can't figure out:

I need somehow to get the bounding box from each block, and compare their heights ( Y coordinates ).

After that insert each block, using polar function - something like:

(setq newBspt (polar prevBspt (DtR 270.0) max-Y) )

The job is half done, it seems I can't get the boundingbox from "Bobj" :

(defun C:test ( / pt att BlockLst Bname Bent Bobj)
(if
	(setq pt (getpoint "\nPick insertion point"))
	(progn
		(setq att (getvar 'attreq))
		(setq BlockLst (tblnext "BLOCK" T))
		(while BlockLst
			(setq Bname (cdr (assoc 2 BlockLst)))
			(setq Bent (tblobjname "block" bname))
			(setq Bobj (vlax-ename->vla-object Bent))
			(setvar 'attreq 0)
			(vl-cmdf "_.-insert" Bname "_S" 1.0 "_R" 0.0 "_non" pt "")
			(setvar 'attreq att)
			(setq BlockLst (tblnext "BLOCK"))
		)
	);progn
);if

(princ)
)

So any ideas?

EDIT:

I attached a sample drawing: Sample-Blk-Preview.dwg , showing the result and whats needed.

EDIT:

This drawing would be more comfortable for testing: tree pln.dwg

Heres some quick and dirty code, but it gets the job done:

; PREVIEW BLOCKS in the drawing

(defun C:test ( / pt att BlockLst Bname Bent Bobj SS ent vla-obj bbox mnPt mxPt currentY maxY blkcnt )
(setvar 'CMDECHO 0)
(if
	(setq pt (getpoint "\nPick insertion point"))
	(progn
		(setq att (getvar 'attreq))
		(setq BlockLst (tblnext "BLOCK" T)) ; check all blocks in the drawing and insert them on "pt"
		(while BlockLst
			(if
				(and
					(setq Bname (cdr (assoc 2 BlockLst)))
					(setq Bent (tblobjname "block" bname))
					(setq Bobj (vlax-ename->vla-object Bent))
				)
				(progn
					(setvar 'attreq 0)
					(vl-cmdf "_.-insert" Bname "_S" 1.0 "_R" 0.0 "_non" pt )
					(setvar 'attreq att)
				)
			)
			(setq BlockLst (tblnext "BLOCK"))
		)
		(if
			(setq SS (ssget "_C" pt pt '((0 . "INSERT")))) ; manually select all the inserted blocks
			(progn
				(defun DtR (d) ( * PI (/ d 180.0)))
				(setq maxY 0)
				(repeat (setq i (sslength SS)) ; iterate trought selection to find maxY
					(setq ent (ssname SS (setq i (1- i)))) ; current entity
					(setq vla-obj (vlax-ename->vla-object ent))
					(setq bbox (vla-getboundingbox vla-obj 'mn 'mx))
					(setq mnPt (trans (vlax-safearray->list mn) 0 1) )
					(setq mxPt (trans (vlax-safearray->list mx) 0 1) )
					(setq currentY (- (cadr mxPt) (cadr mnPt)))
					(if (> currentY maxY) (setq maxY currentY))
				);repeat
				(princ maxY) ; Found maxY
				
				(command "_.erase" SS "") ; erase all inserted blocks
				(setq blkcnt 0)
				(setq BlockLst (tblnext "BLOCK" T)) ; check all blocks in the drawing and insert them on "pt" with incremented polar function
				(while BlockLst
					(setq blkcnt (+ blkcnt 1))
					(if
						(and
							(setq Bname (cdr (assoc 2 BlockLst)))
							(setq Bent (tblobjname "block" bname))
							(setq Bobj (vlax-ename->vla-object Bent))
						)
						(progn
							(setvar 'attreq 0)
							(vl-cmdf "_.-insert" Bname "_S" 1.0 "_R" 0.0 "_non" (if (= blkcnt 1) pt (setq pt (polar pt (DtR 270.0) maxY))) ) 
							(setvar 'attreq att)
						)
					)
					(setq BlockLst (tblnext "BLOCK"))
				)
			); progn
		) ; if
		
	); progn
);if

(princ)
)				

Couldn't figure out anything else.

Your method is sound - the other way to approach this would be to iterate over the objects constituting the block definition and calculate the bounding box of the block definition prior to inserting each block, but your method is equally valid (though, you will receive unexpected results for dynamic blocks - I have posted a more accurate function to calculate the bounding box for a block at the Swamp here [you'll need to wait until the Swamp is back up to view it]).

Here is another way to write the program for your consideration:

(defun c:bprev ( / bpt cnt doc idx llp lst obj spc urp vec )
   (if (setq bpt (getpoint "\nSpecify insertion point: "))
       (progn
           (setq doc (vla-get-activedocument (vlax-get-acad-object))
                 spc (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
                 bpt (trans bpt 1 0)
           )
           (vlax-for blk (vla-get-blocks doc)
               (if (and (= :vlax-false (vla-get-islayout blk))
                        (= :vlax-false (vla-get-isxref   blk))
                        (not (wcmatch  (vla-get-name blk) "`**,`_*,*|*"))
                   )
                   (progn
                       (setq obj (vlax-invoke spc 'insertblock bpt (vla-get-name blk) 1.0 1.0 1.0 0.0))
                       (vla-getboundingbox obj 'llp 'urp)
                       (setq idx (cons (cadr (mapcar '- (vlax-safearray->list urp) (vlax-safearray->list llp))) idx)
                             lst (cons obj lst)
                       )
                   )
               )
           )
           (setq vec  (list 0.0 (- (apply 'max idx)) 0.0)
                 cnt '(0 0 0) 
           )
           (foreach idx (vl-sort-i idx '>)
               (vlax-invoke (nth idx lst) 'move '(0.0 0.0 0.0) (mapcar '* vec cnt))
               (setq cnt (mapcar '1+ cnt))
           )
       )
   )
   (princ)
)
(vl-load-com) (princ)

Hi again Lee,

Your code is flawless.

the other way to approach this would be to iterate over the objects constituting the block definition and calculate the bounding box of the block definition prior to inserting each block

I was wondering exactly how this is done, as I was trying to get the boundingbox by converting the table object to vla-object and get the boundingbox this way - but I was getting an error.

  (if (and (= :vlax-false (vla-get-islayout blk))
                        (= :vlax-false (vla-get-isxref   blk))
                        (not (wcmatch  (vla-get-name blk) "`**,`_*,*|*"))
                   )

And again I see these litte details I would never thought.

I agree that my code is very sound, it represents my limited lisp knowledge.

I'll try to analyse whats happening in your code, although it looks very complex, even if I consider myself as a medium-skilled lisper.

Thank you once again!

Your code is flawless.

Thank you Grrr.

I was wondering exactly how this is done, as I was trying to get the boundingbox by converting the table object to vla-object and get the boundingbox this way - but I was getting an error.

My code over at the Swamp (to which I have provided a link above) gives a complete example of how to do this (the Swamp should be back online any day now!).

I agree that my code is very sound, it represents my limited lisp knowledge.

I'll try to analyse whats happening in your code, although it looks very complex, even if I consider myself as a medium-skilled lisper.

Thank you once again!

You're welcome - feel free to ask if you have any further questions about the posted code.

Lee

Open design center, open drawing tab, double click on blocks, done.

Open design center, open drawing tab, double click on blocks, done.

2nd that!

I use the adcnavigate command in a macro to open Design Center in our MUTCD drawing with street sign blocks.

^C^C^P(command "adcnavigate" "G:/BeaufordT/Blocks/MUTCD.dwg") 

to save time.

Thanks for the advice guys!

But I actually wanted to insert all of the blocks in the drawing in modelspace, to be easely compared and for other purposes.

And the second reason is the coding part (the method required for the code to work isn't anything common) so LM showed us something new to learn from.

Sorry for the misunderstanding, sometimes I suck at explaining what I'm trying to achieve.

Thanks for the advice guys!

But I actually wanted to insert all of the blocks in the drawing in modelspace, to be easely compared and for other purposes.

And the second reason is the coding part (the method required for the code to work isn't anything common) so LM showed us something new to learn from.

 

Sorry for the misunderstanding, sometimes I suck at explaining what I'm trying to achieve.

No problem, I'm a huge fan of Lee's code. Visit his site any time I'm looking for some. Offered option just in case.