Counting of blocks layerwise inside the differently layered closed polygons

[Anonymous]

Dear Helpers,

I got this code from below forum link. I need a small modfication in code.

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/counting-blocks-with-zone-wise/td-p/...

This lisp code gives the block count inside the differently layered polygons only and can't give the block count with block layer names. Please update this code with block count with layer names also. Thank you in advance.

(Defun c:CBPL1 (/ fnc _paddot BlockCollection ss data blocksinside i n bcoll)
(setq fnc '(lambda (e1 e2) (< (car e1) (car e2))))
(defun _paddot ( l s)
(if (< (strlen s) l) (_paddot l (strcat "." s)) s)
)
(if
(setq BlockCollection nil
ss (ssget '((0 . "LWPOLYLINE"))
)
)
(progn
(repeat (setq i (sslength ss))
(setq ent (entget (ssname ss (Setq i (1- i)))))
(Setq data (mapcar 'cdr
(vl-remove-if-not
(function (lambda (d)
(<= 8 (car d) 10)
)
) ent
)
)
zone (cdr (assoc 8 ent))
)

(if (setq blocksinside (ssget "WP" (Cdr data) '((0 . "INSERT"))))
(progn
(repeat (setq n (sslength blocksinside))
(Setq ent (entget (ssname blocksinside (setq n (1- n))))
bname (cdr (assoc 2 ent))
)
(Setq bcoll
(if (Setq f (assoc bname bcoll))
(subst (cons bname (1+ (cdr f))) f bcoll)
(cons (cons bname 1) bcoll)
)
)
)
(Setq BlockCollection
(cons (list zone bcoll) BlockCollection)
bcoll nil
)
)
)
)
(foreach itm (vl-sort BlockCollection fnc)
(foreach zone (vl-sort (Cadr itm) fnc)
(Setq on-screen (strcat "\n" (Car itm) "\t" (car zone) ":"))
(princ
(strcat on-screen
(_paddot (- 50 (strlen on-screen)) (itoa (Cdr zone)))
)
)
)
(print)
)
)
)
(princ)
)

 and this is lisp for block count layerwise with out counting inside the differently layered polygons:

(defun c:LBC (/ en ss ctr bl the_list n)
(setq ss (ssget (list (cons 0 "INSERT")))
ctr (sslength ss)
)
(repeat ctr
(setq ctr (1- ctr)
en (entget (ssname ss ctr))
bl (strcat (cdr (assoc 2 en))"/"(cdr (assoc 8 en)))
)
(if (setq count (cdr (assoc bl the_list)))
(setq the_list (subst (cons bl (1+ count))(cons bl count) the_list))
(setq the_list (cons (cons bl 1) the_list))
)
)
(setq the_list (vl-sort the_list '(lambda (e1 e2)(< (car e1) (car e2)))))
(foreach n the_list
(princ (strcat "\nBlock/Layer: " (car n) ", count of :" (itoa (cdr n))))
)
)

Please try to combine these two lisp codes.

[dbhunia · Accepted solution]

Try this.....(Edited code of @pbejse taken from Here)

For.....

---

@Anonymous wrote:
......................

This lisp code gives the block count inside the differently layered polygons only and can't give the block count with block layer names. Please update this code with block count with layer names also. Thank you in advance.

..........................

---

(Defun c:demo (/ _paddot ss data i n fnc blocksinside bcoll BlockCollection);;put temp variables
(setq fnc '(lambda (e1 e2) (< (car e1) (car e2))))  
(defun _paddot (  l s)
        (if (< (strlen s) l) (_paddot l (strcat "." s)) s)  
)       
(if
  (setq BlockCollection nil
         ss (ssget '((0 . "LWPOLYLINE")))
  )
  (progn
	  (repeat (setq i (sslength ss))
          (setq ent (entget (ssname ss (Setq i (1- i)))))
	     (Setq data (mapcar 'cdr
	                        (vl-remove-if-not
	                          (function (lambda (d)
	                                      (<= 8 (car d) 10)
	                                    )
	                          )	ent
	                        )
	                )
                   zone (cdr (assoc 8 ent))
	     )
          
	     (if (setq blocksinside (ssget "WP" (Cdr data) '((0 . "INSERT"))))
	       (progn
	         (repeat (setq n (sslength blocksinside))
	           (Setq ent   (entget (ssname blocksinside (setq n (1- n))))
	                 bname (cdr (assoc 2 ent))
	                 blay (cdr (assoc 8 ent))
	           )
	           (Setq bcoll
	                  (if (Setq f (assoc (strcat bname "-" blay) bcoll))
	                    (subst (cons (strcat bname "-" blay) (1+ (cdr f))) f bcoll)
	                    (cons (cons (strcat bname "-" blay) 1) bcoll)
	                  )
	           )
	         )
	         (Setq BlockCollection
	                (cons (list zone bcoll) BlockCollection)
	               bcoll nil
	         )
	       )
	     )
	   )
	    (foreach itm (vl-sort BlockCollection fnc)
	      (foreach zone (vl-sort (Cadr itm) fnc)
	        (Setq on-screen (strcat "\n" (Car itm) "\t" (car zone) ":"))
	        (princ
	          (strcat on-screen
	                  (_paddot (- 50 (strlen on-screen)) (itoa (Cdr zone)))
	          )
	        )
	      )
	      (print)
	    )
	)
  )
  (princ)
)

---

---

[Anonymous]

Working as per my requirement. Fentastic Sir.