include nested blocks in block count

Aloha,

Two questions:

First, I'm aware the question about counting nested blocks (along with non-nested
references) has been asked before. Google searching this NG seems to indicate no
reliable solution posted. Has anyone solved it? I appreciate returning the correct
answer looks like a complex problem.

Which leads to my second question. I'm only interested in counting blocks contained
in model space. I'm thinking maybe I could copy the active document ModelSpace
block/collection into a temporary ObjectDBX document. Then use a while loop to
explode blocks in the temp doc until no blocks remain. Within the loop, run a count
looking for the block name in question. Then discard the temporary ObjectDBX
document.

If that approach might work, does anyone have some example code they'd be willing to
share which demonstrates how to create a temporary ObjectDBX document? The document
should be deleted after whatever operations are applied, and values extracted.

Hope this makes some sense...

TIA
Joe Burke

 

Hi Joe.

I haven't actually studied this... Just thinking out loud because I'd like
to help if I can.

Couldn't you:
1. Scan the block record for any nested references, keeping a record of
containing blocks with count of references.
2. For each "block" containing your reference multiply
(sscount (ssget "x" '((0 . "insert") (2 . "block") (-4 . "/=") (67 . 1))))
by the number of nested references found.

I think the "scan" part would require multiple passes or a good list
structure to catch "deep" nesting, but I don't think it would be too bad.
Does this seem workable so far, or am I grossly missing something?

 

James & Joe,
I was looking at this, too. James, your logic is similar to what I was
thinking. A list & ss must be created of every block that holds the initial
block, then a list & ss of blocks that hold those blocks, etc. until list is
nil.

Joe, do you by chance have a sample drawing that has such a block at
different levels of nesting? If so, I would like a 2002 version to play
with.

 

Hi Joe,
James is on the right track. If you want to purchase
a solution that is already developed in the form
(countblocks name layoutobj) the drop me an
email at

Remove the nospam.

 

Oops. I guess that'd be "sslength".

 

Hi Doug,

Will email privately.

Thanks
Joe Burke

 

Hi Jeff,

Sorry, I don't have a good example drawing.

Personally I try to avoid nested blocks. I'm sure others have good reasons for
using them.

Joe Burke

 

Thanks, James.

Yes, that's similar to what I was thinking. Unfortunately I don't have time to get
into it right now. I suspect testing such a thing would be time consuming.

Joe Burke

 

Thank you, James. I'll try it over the weekend and let you know.

Joe Burke

 

Hi James,

I ran some tests over the weekend. Your program reports the correct number of block
refs and nested refs, as far as I can tell. Good stuff... many thanks.

Since I'm not sure I follow the logic, and I would need to make some modifications, I
wrote a new vlisp oriented version from scratch. It reports the same number as your
program in all cases I've tested. I'll send it to you via email if you'd like to take
a look. I just need a valid address.

I'm not posting it here in deference to Doug's commercial version. Or maybe Doug
thinks otherwise?

Thanks to you and Doug for pointing the way.

Regards
Joe Burke

 

Here's a slightly different approach. Note that it filters out xrefs and it won't handle objects on locked layers. Code could be added to temporarily unlock all layers while it runs.

(defun c:BlockCounter ()
(vl-load-com)
(setq block_count 0
target_name (getstring "\nEnter the block name:")
CurSet (ssget "all" '((0 . "insert")(410 . "model")))
)
(while (setq CurEnt (ssname CurSet 0))
(setq CurObj (vlax-ename->vla-object CurEnt))
(if (not (vlax-property-available-p CurObj 'Path))
(BLockChecker CurObj)
)
(ssdel CurEnt CurSet)
)
(princ (strcat (itoa block_count) " block insert" (if (= block_count 1) " was" "s were") " found."))
(princ)
)
(defun BLockChecker (Obj / BlkLst)
(if (= target_name (cdr (assoc 2 (entget (vlax-vla-object->ename Obj)))))
(setq block_count (+ block_count 1))
)
(foreach o (vlax-invoke Obj 'Explode)
(if (eq (vla-get-ObjectName o) "AcDbBlockReference")
(setq BlkLst (append BlkLst (BLockChecker o)))
)
(vla-delete o)
)
)
(princ "Type BlockCounter to begin.")
(princ)

 

Joe,
Please feel free to post it. You're not stepping on any toes. ;-)
Regards,
Doug

 

"I'm not posting it here in deference to Doug's commercial version."

Oops. Didn't even think about that... Sorry Doug.

As far as my "logic";
1. BC:MasterBlockList: I scan the block record once making a master list in
the form of ((blk1) (blk2 nblk1 nblk1 ...) (blk3 nblk2 ...) ...)
2. BC:FlattenMasterList: Then I loop the master list replacing intermediate
blocks (except the desired one) with their nested blocks until the new list
matches the previous one. ((blk1) (blk2 nblk1 nblk1 ...) (blk3 nblk1 nblk1
.... ...) ...)
3. (setq mlst (mapcar ... Convert the list to ((blk1 . #) (blk2 . #) (blk3
.. #)...) where # is the total number of desired nested blocks found.
4. (foreach blk mlst ... Total the count of each block multiplied by the
number of references for that block.

Joe, I'm glad I could help.

 

James' blockcount routine returns accurate results but the listing technique it uses makes things run very slow. If speed matters and/or you'll be counting blocks on a large drawing, I think you'll find that the process I use in my blockcounter routine (previously posted further down in this thread) works considerably faster.

 

Hi James,
You never need to apologize for helping folks. Your approach
is interesting. I used a similar approach with vlisp and recursion.

Regards,
Doug

 

Thank you Doug.
The generosity I find here is encouraging and it's nice to get a chance to
reciprocate.
James

 

James and Doug,

Here's my stab at it. Comments welcome.

;; Joe Burke 8/22/2004
;; return a count of block references and all nested references
;; argument: "blockname"
(defun CountBlocks (searchname / cnt blocks blkname blklst
nstlst cntlst ss subtotal total)
(setq searchname (strcase searchname))
(setq blocks
(vla-get-blocks
(vla-get-activedocument
(vlax-get-acad-object))))

(vlax-for blk blocks
(setq blkname (strcase (vlax-get blk 'Name)))
(if
(and
(not (vl-string-search "|" blkname)) ;filter blocks in xrefs
(not (vl-string-search "*" blkname)) ;filter "*MODEL_SPACE" "*PAPER_SPACE"
(/= -1 (vlax-get blk 'IsXRef)) ;filter xref blocks
) ;don't filter Paste As blocks
(setq blklst (cons blk blklst))
)
) ;for

(foreach x blklst
(setq cnt 0)
(setq nstlst (GetNestedNames x))
(setq blkname (strcase (vlax-get x 'Name)))
(if (vl-position searchname nstlst)
(progn
(foreach y nstlst
(if (= searchname y)
(setq cnt (1+ cnt))
)
)
(setq pair (cons blkname cnt)) ;dotted pair
(setq cntlst (cons pair cntlst)) ;list of dotted pairs
)
)
) ;foreach

;example cntlst
;(("TESTNST2" . 2) ("TESTNST" . 2)
; ("GAR01-02 NESTED DRIVE" . 1) ("GAR1-02" . 1))

(setq total 0)
(foreach x cntlst
(setq cnt 0)
(setq subtotal 0)
(if (setq ss (ssget "x" (list (cons 0 "INSERT") (cons 2 (car x)))))
(setq cnt (sslength ss))
)
(setq subtotal (* cnt (cdr x)))
(setq total (+ subtotal total))
) ;foreach

(princ (strcat "\nTotal of block " searchname " = " (itoa total)))
(princ)
) ;end

;; sub-function: return a list of block names
;; first the name of the block definition,
;; then the names of all nested blocks
;; argument: a block definition
;; example return list: ("blkdefname" "abc" "abc" "xyz" "xyz")
(defun GetNestedNames ( blkdef / newlst data blk lst namelst blkname )
;first level deep
(vlax-for x blkdef
(if (= "AcDbBlockReference" (vlax-get x 'ObjectName))
(setq newlst (cons x newlst))
)
)

(setq data newlst)
(while data
(foreach x data
(setq blk (vla-item *blocks* (vlax-get x 'Name)))
(vlax-for x blk
(if (= "AcDbBlockReference" (vlax-get x 'ObjectName))
(setq lst (cons x lst))
)
)
) ;foreach
(if lst (setq newlst (cons lst newlst)))
(setq data lst) ;drill down
(setq lst nil) ;right
) ;while

;following ensures any single block ref is a (list)
;otherwise the flatten operation fails since each reference isn't a list
(setq newlst (mapcar '(lambda (x)
(if (= 'VLA-OBJECT (type x)) (list x) x)) newlst))
(setq newlst (apply 'append newlst)) ;flatten newlst
(foreach x newlst
(setq namelst (cons (strcase (vlax-get x 'Name)) namelst))
)
(setq blkname (strcase (vlax-get blkdef 'Name)))
(cons blkname namelst) ;add the block def name, return list
) ;end

 

Noticed a mistake as noted... reposting.

;; Joe Burke 8/22/2004
;; return a count of block references and all nested references
;; argument: "blockname"
(defun CountBlocks (searchname / cnt blocks blkname blklst
nstlst cntlst ss subtotal total)
(setq searchname (strcase searchname))
(setq blocks
(vla-get-blocks
(vla-get-activedocument
(vlax-get-acad-object))))

(vlax-for blk blocks
(setq blkname (strcase (vlax-get blk 'Name)))
(if
(and
(not (vl-string-search "|" blkname)) ;filter blocks in xrefs
(not (vl-string-search "*" blkname)) ;filter "*MODEL_SPACE" "*PAPER_SPACE"
(/= -1 (vlax-get blk 'IsXRef)) ;filter xref blocks
) ;don't filter Paste As blocks
(setq blklst (cons blk blklst))
)
) ;for

(foreach x blklst
(setq cnt 0)
(setq nstlst (GetNestedNames x))
(setq blkname (strcase (vlax-get x 'Name)))
(if (vl-position searchname nstlst)
(progn
(foreach y nstlst
(if (= searchname y)
(setq cnt (1+ cnt))
)
)
(setq pair (cons blkname cnt)) ;dotted pair
(setq cntlst (cons pair cntlst)) ;list of dotted pairs
)
)
) ;foreach

;example cntlst
;(("TESTNST2" . 2) ("TESTNST" . 2)
; ("GAR01-02 NESTED DRIVE" . 1) ("GAR1-02" . 1))

(setq total 0)
(foreach x cntlst
(setq cnt 0)
(setq subtotal 0)
(if (setq ss (ssget "x" (list (cons 0 "INSERT") (cons 2 (car x)))))
(setq cnt (sslength ss))
)
(setq subtotal (* cnt (cdr x)))
(setq total (+ subtotal total))
) ;foreach

(princ (strcat "\nTotal of block " searchname " = " (itoa total)))
(princ)
) ;end

;; sub-function: return a list of block names
;; first the name of the block definition,
;; then the names of all nested blocks
;; argument: a block definition
;; example return list: ("blkdefname" "abc" "abc" "xyz" "xyz")
(defun GetNestedNames ( blkdef / newlst data blk lst namelst blkname )
;first level deep
(vlax-for x blkdef
(if (= "AcDbBlockReference" (vlax-get x 'ObjectName))
(setq newlst (cons x newlst))
)
)

(setq data newlst)
(while data
(foreach x data
(setq blk (vla-item blocks (vlax-get x 'Name))) ; fixed *blocks* 8/23
(vlax-for x blk
(if (= "AcDbBlockReference" (vlax-get x 'ObjectName))
(setq lst (cons x lst))
)
)
) ;foreach
(if lst (setq newlst (cons lst newlst)))
(setq data lst) ;drill down
(setq lst nil) ;right
) ;while

;following ensures any single block ref is a (list)
;otherwise the flatten operation fails since each reference isn't a list
(setq newlst (mapcar '(lambda (x)
(if (= 'VLA-OBJECT (type x)) (list x) x)) newlst))
(setq newlst (apply 'append newlst)) ;flatten newlst
(foreach x newlst
(setq namelst (cons (strcase (vlax-get x 'Name)) namelst))
)
(setq blkname (strcase (vlax-get blkdef 'Name)))
(cons blkname namelst) ;add the block def name, return list
) ;end

 

Hi,
I try appload the lisp in my AutoCAD, just wanted to ask what is the command going to type in.

thanks,

JJ Purugganan