Topic: Count Blocks with Circles and Exploded Circles

[MSTG007]

I was searching on the web and found this link

http://www.cadforums.net/showthread.php/1748-entity-in-blocks

Code: [Select]

;;For nested blk
 ;;(tttt <objectname>)
 ;;(tttt "AcDbCircle")
 ;;By LUCAS

 (defun TTTT (OBJECTNAME / BLK BLKS COUNT ENT)
 (vl-load-com)

 (defun TTT1 (BLK / ENT)
 (vlax-for ENT (vla-item BLKS (vla-get-name BLK))
 (cond
 ((= (vla-get-objectname ENT) OBJECTNAME)
 (setq COUNT (1+ COUNT))
 )
 ((= (vla-get-objectname ENT) "AcDbBlockReference")
 (TTT1 ENT)
 )
 )
 )
 )

 (setq BLK (car (entsel "\nSelect Block: "))
 COUNT 0
 BLKS (vla-get-blocks
 (vla-get-activedocument (vlax-get-acad-object))
 )
 BLK (vlax-ename->vla-object BLK)
 )
 (TTT1 BLK)
 (vlax-release-object BLKS)
 COUNT
 )

Again, no such luck trying to get it to do it. But I thought what the heck , I should ask!

[Lee Mac]

Exploded circles? 

[ChrisCarlson]

Maybe he means arcs? An exploded circle can be an arc but an arc cannot always be a circle. 

[David Bethel]

An ARC must be less than 360 Degrees

[MSTG007]

Sorry guys for not getting back.. It was suppose to be circles within blocks and circles that are "exploded" or not part of a block. So it would count all circles in the selection set. Something like that.

[ronjonp]

Well this counts circles... Maybe tie the "exploded circles" to a block by referencing the block insertion to the circle center point. Perhaps an example drawing?

Code - Auto/Visual Lisp: [Select]

1. (alert (vl-prin1-to-string (length (ssget "_x" '((0 . "circle"))))))

[MSTG007]

here is what is in the drawing. I have a block that is a square with a circle in it copied a lot. Then I took the block and bursted it. (exploded wise). Finally I exploded the block. Object is to select with a window all the objects and just count how many circles are there.

[ronjonp]

Just take the "_x" out of the code above.

[ribarm]

I don't know, maybe just try this :

Code - Auto/Visual Lisp: [Select]

1. (defun c:countcircles ( / countcircles *adoc* *blks* n )
2.  
3.   (vl-load-com)
4.  
5.   (defun countcircles ( objcoll )
6.     (vlax-for o objcoll
7.       (cond
8.         ( (= (vla-get-objectname o) "AcDbCircle")
9.           (setq n (1+ n))
10.         )
11.         ( (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-count (list o)))
12.           nil
13.         )
14.         ( (/= (vla-get-count o) 0)
15.           (countcircles o)
16.         )
17.       )
18.     )
19.   )
20.  
21.   (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))
22.   (setq *blks* (vla-get-blocks *adoc*))
23.   (setq n 0)
24.   (countcircles *blks*)
25.   (alert (strcat "Total : " (itoa n) " circle entities bound/unbound to block(s)..."))
26.   (princ)
27. )
28.  

[MSTG007]

Awesome. but I am getting an

C:COUNTCIRCLES
Command: COUNTCIRCLES
; error: ActiveX Server returned the error: unknown name: Count
Command:

[ribarm]

I don't know... Try it now - slight change in the code...

[MSTG007]

That time the lisp executed and I had a popup box saying there is 526 circle entities bound/unbound to block(s)...

There are 525 circle entities. But there are 105 Blocks with circles in them.

I am guessing that it only count one block? other than that ... it does work!

[roy_043]

@ MSTG007: You have asked this question before:
http://www.theswamp.org/index.php?topic=49769.msg550267#msg550267

[ribarm]

If there are 525 circles, than it should count them as 525... I guess you missed one hidden to you somewhere in your DWG...

[Lee Mac]

I would suggest:

Code - Auto/Visual Lisp: [Select]

1. (defun c:cc ( / c d e i l s )
2.     (while (setq d (tblnext "block" (not d)))
3.         (setq e (tblobjname "block" (cdr (assoc 2 d)))
4.               c 0
5.         )
6.         (while (setq e (entnext e))
7.             (if (= "CIRCLE" (cdr (assoc 0 (entget e))))
8.                 (setq c (1+ c))
9.             )
10.         )
11.         (setq l (cons (cons (cdr (assoc 2 d)) c) l))
12.     )
13.     (setq c 0)
14.     (if (setq s (ssget '((0 . "CIRCLE,INSERT"))))
15.         (progn
16.             (repeat (setq i (sslength s))
17.                 (setq e (entget (ssname s (setq i (1- i)))))
18.                 (if (= "CIRCLE" (cdr (assoc 0 e)))
19.                     (setq c (1+ c))
20.                     (setq c (+ c (cdr (assoc (cdr (assoc 2 e)) l))))
21.                 )
22.             )
23.             (princ (strcat "\n" (itoa c) " circles found."))
24.         )
25.     )
26.     (princ)
27. )

[MSTG007]

geesh. Dude... you got it. wow. Thanks for everyones help on it! I greatly appreciated it.

[Lee Mac]

If there are 525 circles, than it should count them as 525... I guess you missed one hidden to you somewhere in your DWG...

Note that you are counting circles within block definitions only once, and not for each reference of the definition; aside, I shudder to think how many times the vl-catch-all-apply expression will error... 

[MSTG007]

interesting... thinking outside my box again. will this work with counting circles in dynamic blocks as well?

[roy_043]

Well, I am out.

[ribarm]

FWIW, this will count any entity type within/unbound to any INSERT references nested into any level deep and you may also choose space where those etypes reside...

Code - Auto/Visual Lisp: [Select]

1. ;;; (countetype "*" t t) ;; "*" - stretype ; t - unbound ; t - activespace
2. ;;; (countetype "CIRCLE" t t) ;; "CIRCLE" - stretype ; t - unbound ; t - activespace
3. ;;; (countetype "LINE" nil t) ;; "LINE" - stretype ; nil - bound to blocks/xrefs nested to any depth ; t - activespace
4. ;;; (countetype "INSERT" nil nil)  ;; "INSERT" - stretype ; nil - bound to blocks/xrefs nested to any depth ; nil - database
5.  
6. (defun countetype ( stretype unbound-bound activespace-database / ss n i insref blkbeginslst blkbegin ent l )
7.   (if (and stretype (not (eq stretype "")) (eq (type stretype) 'STR))
8.     (cond
9.       ( (and unbound-bound activespace-database)
10.         (setq ss (ssget "_X" (list (cons 0 stretype) (cons 410 (if (= (getvar 'cvport) 1) (getvar 'ctab) "Model")))))
11.         (prompt (strcat "\nTotal : " (if ss (itoa (sslength ss)) "0") " \"" stretype "\"" " unbound to blocks/xrefs in active space\n"))
12.         (if ss (sslength ss) 0)
13.       )
14.       ( (and (not unbound-bound) activespace-database)
15.         (setq n 0)
16.         (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 410 (if (= (getvar 'cvport) 1) (getvar 'ctab) "Model")))))
17.         (if ss
18.           (progn
19.             (repeat (setq i (sslength ss))
20.               (setq insref (ssname ss (setq i (1- i))))
21.               (setq blkbeginslst (cons (refnestedblkbeginslst insref) blkbeginslst))
22.               (setq l nil)
23.             )
24.             (foreach blkbegins blkbeginslst
25.               (foreach blkbegin blkbegins
26.                 (setq ent blkbegin)
27.                 (while (setq ent (entnext ent))
28.                   (if (wcmatch (cdr (assoc 0 (entget ent))) stretype)
29.                     (setq n (1+ n))
30.                   )
31.                 )
32.               )
33.             )
34.           )
35.         )
36.         (prompt (strcat "\nTotal : " (itoa n) " \"" stretype "\"" " bound to blocks/xrefs in active space\n"))
37.         n
38.       )
39.       ( (and unbound-bound (not activespace-database))
40.         (setq ss (ssget "_X" (list (cons 0 stretype))))
41.         (prompt (strcat "\nTotal : " (if ss (itoa (sslength ss)) "0") " \"" stretype "\"" " unbound to blocks/xrefs in database\n"))
42.         (if ss (sslength ss) 0)
43.       )
44.       ( (and (not unbound-bound) (not activespace-database))
45.         (setq n 0)
46.         (setq ss (ssget "_X" (list (cons 0 "INSERT"))))
47.         (if ss
48.           (progn
49.             (repeat (setq i (sslength ss))
50.               (setq insref (ssname ss (setq i (1- i))))
51.               (setq blkbeginslst (cons (refnestedblkbeginslst insref) blkbeginslst))
52.               (setq l nil)
53.             )
54.             (foreach blkbegins blkbeginslst
55.               (foreach blkbegin blkbegins
56.                 (setq ent blkbegin)
57.                 (while (setq ent (entnext ent))
58.                   (if (wcmatch (cdr (assoc 0 (entget ent))) stretype)
59.                     (setq n (1+ n))
60.                   )
61.                 )
62.               )
63.             )
64.           )
65.         )
66.         (prompt (strcat "\nTotal : " (itoa n) " \"" stretype "\"" " bound to blocks/xrefs in database\n"))
67.         n
68.       )
69.     )
70.     (prompt "\nInvalid entity type string specified as starting argument...")
71.   )
72. )
73.  
74. (defun refnestedblkbeginslst ( ref / e )
75.   (setq ref (tblobjname "BLOCK" (cdr (assoc 2 (entget ref)))))
76.   (setq e ref)
77.   (setq l (append l (list ref)))
78.   (while (setq e (entnext e))
79.     (if (eq (cdr (assoc 0 (entget e))) "INSERT")
80.       (progn
81.         (setq l (append l (list e)))
82.         (refnestedblkbeginslst e)
83.       )
84.     )
85.   )
86.   l
87. )
88.  
89. ;;; (alert (strcat "Total number of circle entities within DWG is : " (itoa (+ (countetype "CIRCLE" t nil) (countetype "CIRCLE" nil nil)))))
90.  

Regards, M.R.

[MSTG007]

Woooow. Or whooot!!!!

[Lee Mac]

I would suggest:

Code - Auto/Visual Lisp: [Select]

1. (defun c:cc ( / c d e i l s )
2.     (while (setq d (tblnext "block" (not d)))
3.         (setq e (tblobjname "block" (cdr (assoc 2 d)))
4.               c 0
5.         )
6.         (while (setq e (entnext e))
7.             (if (= "CIRCLE" (cdr (assoc 0 (entget e))))
8.                 (setq c (1+ c))
9.             )
10.         )
11.         (setq l (cons (cons (cdr (assoc 2 d)) c) l))
12.     )
13.     (setq c 0)
14.     (if (setq s (ssget '((0 . "CIRCLE,INSERT"))))
15.         (progn
16.             (repeat (setq i (sslength s))
17.                 (setq e (entget (ssname s (setq i (1- i)))))
18.                 (if (= "CIRCLE" (cdr (assoc 0 e)))
19.                     (setq c (1+ c))
20.                     (setq c (+ c (cdr (assoc (cdr (assoc 2 e)) l))))
21.                 )
22.             )
23.             (princ (strcat "\n" (itoa c) " circles found."))
24.         )
25.     )
26.     (princ)
27. )

To account for nested blocks (to any depth):

Code - Auto/Visual Lisp: [Select]

1. (defun c:cc ( / cnt def enx idx lst sel )
2.     (while (setq def (tblnext "block" (not def)))
3.         (setq lst (circlesinblock (cdr (assoc 2 def)) lst))
4.     )
5.     (setq cnt 0)
6.     (if (setq sel (ssget '((0 . "CIRCLE,INSERT"))))
7.         (progn
8.             (repeat (setq idx (sslength sel))
9.                 (setq enx (entget (ssname sel (setq idx (1- idx)))))
10.                 (if (= "CIRCLE" (cdr (assoc 0 enx)))
11.                     (setq cnt (1+ cnt))
12.                     (setq cnt (+  cnt (cdr (assoc (cdr (assoc 2 enx)) lst))))
13.                 )
14.             )
15.             (princ (strcat "\n" (itoa cnt) " circles found."))
16.         )
17.     )
18.     (princ)
19. )
20. (defun circlesinblock ( blk lst / ent enx rtn )
21.     (cond
22.         (   (assoc blk lst) lst)
23.         (   (setq rtn 0
24.                   ent (tblobjname "block" blk)
25.             )
26.             (while (setq ent (entnext ent))
27.                 (setq enx (entget ent))
28.                 (cond
29.                     (   (= "CIRCLE" (cdr (assoc 0 enx)))
30.                         (setq rtn (1+ rtn))
31.                     )
32.                     (   (= "INSERT" (cdr (assoc 0 enx)))
33.                         (setq lst (circlesinblock (cdr (assoc 2 enx)) lst)
34.                               rtn (+  (cdr (assoc (cdr (assoc 2 enx)) lst)) rtn)
35.                         )
36.                     )
37.                 )
38.             )
39.             (cons (cons blk rtn) lst)
40.         )
41.         (   (cons (cons blk 0) lst))
42.     )
43. )