Is there a way to make this LISP to count blocks inside another block?

Anonymous · ‎07-31-2019

I use this LISP to count how many blocks there is inside my dwg.

I attached 2 jpeg to make more understandable.

The first one, (IMG_01) there's 3 blocks (A, B and C). And the text next to them count how many of them there is on my DWG.

The second one (IMG_02) shows the same blocks, but they are inside another block (let's call it ABC). When I use the recount LISP, it shows 0.

Is there a way to make this LISP comand to count those blocks when they are inside another block?

Here's the LISP recount I use.

(defun c:recount (/ block_list cnt env_name)
(setq block_list
(list
(cons '2 "A")
(cons '2 "B")
(cons '2 "C")
)
)
(foreach i block_list
(if
(setq ss (ssget "X" (list '(0 . "INSERT") i)))

(progn
(setq
cnt (itoa (sslength ss))
env_name (strcat "BLOCK_COUNT_" (cdr i))
)
(setenv env_name cnt)
(princ (strcat "\nSet " env_name " to " cnt))
)

(progn
(setq
cnt "0"
env_name (strcat "BLOCK_COUNT_" (cdr i))
)
(setenv env_name cnt)
(princ (strcat "\nSet " env_name " to " cnt))
)

)
)
(command "_REGEN") ;_refreshes field values
(princ)
)

And here's DieselExpression I use on the texts next to the blocks (to count the block "A", for example)

$(getenv, BLOCK_COUNT_A)

I've done all this using this topic as reference, but my knowledge using LISP is very limited to help with my issue.

ronjonp · ‎07-31-2019

Your first issue is your block filter does not contain the name of the host block that houses all the nested blocks. FWIW you also might want to use a global variable rather than setenv. Setenv writes to the registry so if you forget to run the code and open another drawing with the same reference your results could be wrong.

Give this a try:

(defun c:recount (/ blockcomponents bn el l s)
  ;; Source for sub
  ;;  https://www.cadtutor.net/forum/topic/67956-reference-to-objects-nested-in-a-block/?tab=comments#comment-551722
  (defun blockcomponents (blk / ent enx lst)
    (if	(setq ent (tblobjname "block" blk))
      (while (setq ent (entnext ent))
	(if (= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
	  (setq lst (append (blockcomponents (cdr (assoc 2 enx))) (cons ent lst)))
	  (setq lst (cons ent lst))
	)
      )
    )
    (reverse lst)
  )
  ;; RJP » 2019-07-31
  (cond	((setq s (ssget "_X" '((0 . "INSERT"))))
	 ;; Unnested blocks
	 (foreach b (mapcar 'cadr (ssnamex s))
	   (if (assoc (setq bn (cdr (assoc 2 (entget b)))) l)
	     (setq l (subst (cons bn (1+ (cdr (assoc bn l)))) (assoc bn l) l))
	     (setq l (cons (cons bn 1) l))
	   )
	   ;; Nested blocks
	   (foreach x (blockcomponents (cdr (assoc 2 (entget b))))
	     (if (= "INSERT" (cdr (assoc 0 (setq el (entget x)))))
	       (if (assoc (setq bn (cdr (assoc 2 el))) l)
		 (setq l (subst (cons bn (1+ (cdr (assoc bn l)))) (assoc bn l) l))
		 (setq l (cons (cons bn 1) l))
	       )
	     )
	   )
	 )
	 (foreach x l
	   (setenv (strcat "BLOCK_COUNT_" (car x)) (itoa (cdr x)))
	   (print (strcat "BLOCK_COUNT_" (car x) " - " (itoa (cdr x))))
	 )
	)
  )
  (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport)
  (princ)
)

Anonymous · ‎07-31-2019

Thanks for your response, rperez!

It worked really well! But is there any way to your lisp set to 0 when theres no other block in the dwg?

I see a small issue that if I add or delete block A for example, the numbers update if I use the recount command, but it stucks to the last number if I delete all the A blocks from the dwg.

ronjonp · ‎07-31-2019

Try this much more simplified version 🙂

(defun c:recount (/ b br i)
  ;; RJP » 2019-07-31
  ;; Does not work with modified dynamic blocks
  (while (setq b (tblnext "block" (not b)))
    (cond ((not (assoc 1 b))
	   (setq bn (cdr (assoc 2 b)))
	   (setq br (entget (cdr (assoc 330 (entget (tblobjname "block" bn))))))
	   (setq i (vl-remove-if
		     '(lambda (x) (or (and (= 331 (car x)) (null (entget (cdr x)))) (/= 331 (car x))))
		     br
		   )
	   )
	   (setenv (strcat "BLOCK_COUNT_" bn) (itoa (length i)))
	   (print (strcat bn " - " (itoa (length i))))
	  )
    )
  )
  (and bn (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport))
  (princ)
)

ronjonp · ‎07-31-2019

The code above does not seem to work with nested so try this:

(defun c:recount (/ blockcomponents b bn el l s)
  ;;  Source for sub
  ;;  https://www.cadtutor.net/forum/topic/67956-reference-to-objects-nested-in-a-block/?tab=comments#comment-551722
  (defun blockcomponents (blk / ent enx lst)
    (if	(setq ent (tblobjname "block" blk))
      (while (setq ent (entnext ent))
	(if (= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
	  (setq lst (append (blockcomponents (cdr (assoc 2 enx))) (cons ent lst)))
	  (setq lst (cons ent lst))
	)
      )
    )
    (reverse lst)
  )
  ;; RJP » 2019-07-31
  (cond	((setq s (ssget "_X" '((0 . "INSERT"))))
	 ;; Unnested blocks
	 (foreach b (mapcar 'cadr (ssnamex s))
	   (if (assoc (setq bn (cdr (assoc 2 (entget b)))) l)
	     (setq l (subst (cons bn (1+ (cdr (assoc bn l)))) (assoc bn l) l))
	     (setq l (cons (cons bn 1) l))
	   )
	   ;; Nested blocks
	   (foreach x (blockcomponents bn)
	     (if (= "INSERT" (cdr (assoc 0 (setq el (entget x)))))
	       (if (assoc (setq bn (cdr (assoc 2 el))) l)
		 (setq l (subst (cons bn (1+ (cdr (assoc bn l)))) (assoc bn l) l))
		 (setq l (cons (cons bn 1) l))
	       )
	     )
	   )
	 )
	 ;; Set variables
	 (foreach x l
	   (setenv (strcat "BLOCK_COUNT_" (car x)) (itoa (cdr x)))
	   (print (strcat "BLOCK_COUNT_" (car x) " - " (itoa (cdr x))))
	 )
	)
  )
  ;; Check for blocks with no inserts
  ;; this can be fooled by a purge...
  (while (setq b (tblnext "block" (not b)))
    (cond ((and (not (assoc 1 b)) (not (member (setq bn (cdr (assoc 2 b))) (mapcar 'car l))))
	   (setenv (strcat "BLOCK_COUNT_" bn) "0")
	   (print (strcat "BLOCK_COUNT_" bn " - " "0"))
	  )
    )
  )
  (and bn (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport))
  (princ)
)

Moshe-A · ‎07-31-2019

@Anonymous hi,

check this one

enjoy

moshe

(vl-load-com) ; load activex support

(defun c:recount (/ go_dig ; local function
		    bnames^ doc blocks modelSpace lst)

 ; recursion function
 (defun go_dig (AcDbBlkTblRec / build_data ; local function
		                cnt0 cnt1 cnt2)

  (defun build_data (bn n / item)
   (if (> n 0)
    (if (setq item (assoc bn lst))
     (setq lst (cons (cons bn (+ (cdr item) n)) (vl-remove item lst)))
     (setq lst (cons (cons bn n) lst))
    ) 
   ); if
  ); build_data
   
  (setq cnt0 0 cnt1 0 cnt2 0)
  (vlax-for AcDbEntity AcDbBlkTblRec 
   (if (eq (vla-get-objectName AcDbEntity) "AcDbBlockReference")
    (cond
     ((eq (strcase (vla-get-effectivename AcDbEntity)) (strcase (nth 0 bnames^)))
      (setq cnt0 (1+ cnt0))
     ) 
     ((eq (strcase (vla-get-effectivename AcDbEntity)) (strcase (nth 1 bnames^)))
      (setq cnt1 (1+ cnt1))
      ) 
     ((eq (strcase (vla-get-effectivename AcDbEntity)) (strcase (nth 2 bnames^)))
      (setq cnt2 (1+ cnt2))
     )
     ( t
      (go_dig (vla-item blocks (vla-get-effectiveName AcDbEntity))) ; recursion call
     )
    ); cond 
   ); if

   (vlax-release-object AcDbEntity) 
  ); vlax-for

  (setq i -1 counter^ (list cnt0 cnt1 cnt2))
  (repeat (vl-list-length counter^)
   (setq i (1+ i))
   (build_data (strcase (nth i bnames^)) (nth i counter^))
  ); repeat
 ); go_dig
  

 ; here start c:recount
 (setq bnames^ (list "block_count_a" "block_count_b" "block_count_c"))
  
 (setq doc (vla-get-activedocument (vlax-get-acad-object))) 
 (setq blocks (vla-get-blocks doc))
 (setq modelSpace (vla-get-modelspace doc))
  
 (go_dig modelSpace)

 ; dispose memory 
 (foreach var (list modelSpace blocks doc)
  (vlax-release-object var)
 )

 ; result 
 (foreach item (vl-sort lst (function (lambda (s0 s1) (< (car s0) (car s1)))))
  (princ (strcat "\nBlock " (car item) " = " (itoa (cdr item))))
 )

 (princ)
); c:recount

Moshe-A · ‎08-01-2019

@Anonymous hi,

And this is a much better solution...at start it builds a dotted pair list of blocks name to search for. you need to specify (see it in red) your blocks name and that's it. make sure you spell it right (only blocks you specifies there will be count)

enjoy

moshe

(vl-load-com) ; load activex support

(defun c:recount (/ go_dig ; local function
		    bnames^ doc blocks modelSpace)

 ; recursion function
 (defun go_dig (AcDbBlkTblRec)
  (vlax-for AcDbEntity AcDbBlkTblRec 
   (if (eq (vla-get-objectName AcDbEntity) "AcDbBlockReference")
    (if (not
           (vl-some
             '(lambda (item)
                (if (eq (strcase (vla-get-effectivename AcDbEntity)) (car item))
                 (setq bnames^ (cons (cons (car item) (1+ (cdr item))) (vl-remove item bnames^)))
	        )
 	      ); lambda
             bnames^
           ); vl-some
	 ); not   
      (go_dig (vla-item blocks (vla-get-effectiveName AcDbEntity))) ; recursion call
    ); if
   ); if

   (vlax-release-object AcDbEntity) 
  ); vlax-for
 ); go_dig
  

 ; here start c:recount
 (setq bnames^ (mapcar		; define commnad data 
                '(lambda (bn)
                  (cons (strcase bn) 0)
                 )
                (list "block_count_a" "block_count_b" "block_count_c"); specify blocks name here
	       ); mapcar
 ); setq
  
 (setq doc (vla-get-activedocument (vlax-get-acad-object))) 
 (setq blocks (vla-get-blocks doc))
 (setq modelSpace (vla-get-modelspace doc))
  
 (go_dig modelSpace)

 ; dispose memory 
 (foreach var (list modelSpace blocks doc)
  (vlax-release-object var)
 )

 ; result 
 (foreach item (vl-sort bnames^ (function (lambda (s0 s1) (< (car s0) (car s1)))))
  (princ (strcat "\nBlock " (car item) " = " (itoa (cdr item))))
 )

 (princ)
); c:recount

Anonymous · ‎08-02-2019

Thanks for all your responses!
I'll try all of them and come back to say if any of them worked.

Anonymous · ‎08-02-2019

When I use the command recount and open the command bar (pressing F2), it shows there the quantity of each blocks I put the name on your lisp. But the texts (the same I used on IMG_01 and IMG_02) dosen't change at all.

Might that be something wrong with my DieselExpression? I haven't change it since my first post. It stills the same.

$(getenv, BLOCK_COUNT_A)

Anonymous · ‎08-02-2019

This actually do the work for me, but the issue when there's zero blocks C, for example, the numbers still the same.

Let's say the drawing DWG_1 has:

1 block A
2 blocks B
3 blocks C.

When I copy the same texts to another DWG_2 that has:
2 blocks A
1 block B

0 blocks C

When in DWG_2 I use the recount, the block C dosen't change the texts to 0. It stucks on 3 from previously dwg

I actually manage to work around this:

I'm not that expert as you when comes about LISP, but it seems the recount dosen't change texts when there's no block with the same name on the dwg.

What do I do? I copy the block C and paste to the DWG_2 (even though I don't need block C on this dwg) and delete him right after. And them, proceed to use the recount again and JUST NOW, the text change to zero.

I don't want to ask more of you guys; you've been amazing with me with those LISPS, but is there a way to work around this?

Thanks!

Moshe-A · ‎08-02-2019

@Anonymous hi,

why do you need this??? describe where are you using it. with lisp you can solve any problem without using environment variables.

$(getenv, BLOCK_COUNT_A)

Anonymous · ‎08-02-2019

As I mentioned on my first post, I use this DieselExpression for those texts to show how many blocks has on the DWG.

I used this topic at first to help me out with that.

Moshe-A · ‎08-02-2019

can you post a sample dwg?

ronjonp · ‎08-02-2019

Did you try THIS version?

Anonymous · ‎08-02-2019

Sure!
Here it is.

ronjonp · ‎08-02-2019

Quick test and the code I linked to works fine.

Anonymous · ‎08-02-2019

Try to create another DWG from zero and paste blocks A and B ONLY, but ALL the 3 texts with the DieselExpression and use recount.

If you manage to do it correctly, them the problem might be something wrong I've been doing, wich I don't know what it is 😞

ronjonp · ‎08-02-2019

Of course it won't work .. you have to either cross reference blocks in the drawing to fields or the fields in the drawing to blocks. If you look at my comments "A purge can fool this" is essentially what you are doing when you create a new drawing and only paste in a portion of the blocks and all the fields.

Anonymous · ‎08-02-2019

Oh! I see.

Well, I can live with that. Your LISP should do the work for me!

One last thing, even in this topic I've mentioned, the last post there is a person asking if the LISP can count dynamic blocs as well. Is it possible? I use some of them and realised them don't count.

Moshe-A · ‎08-02-2019

@Anonymous

add the red line to the last part of the code and you will get what you want

(foreach item (vl-sort bnames^ (function (lambda (s0 s1) (< (car s0) (car s1)))))
  (setenv (car item) (itoa (cdr item)))
  (princ (strcat "\nBlock " (car item) " = " (itoa (cdr item))))
 )

please mark this as your solution.

moshe

Community

Is there a way to make this LISP to count blocks inside another block?

Is there a way to make this LISP to count blocks inside another block?

Is there a way to make this LISP to count blocks inside another block?