Topic: Count Blocks with Circles and Exploded Circles

[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. )