COUNTING BLOCKS WITH ZONE WISE

[Anonymous]

Hi helpers, Need a small modification in lisp

Dear Helpers,

I have a lisp code that can count blocks in different layer. I need a modification like it can give blocks quantities in selected closed polylines which are in different layers.

I have two lisp codes now. Can anyone please help me to recode them.

Lisp code 1: (LIST THE TOTAL BLOCK COUNT WITH NAMES IN SELECTED AREA)

(defun C:BLKLST (/ BLKS CHK I J K L L1 N BNAME ENAME EDATA BLIST BNUM
                  BNAME1 BNAME2 TEMP1 TEMP2
                 )
  (princ "\nUse standard selection methods to ")
  (setq BLKS (ssget (list (cons 0 "INSERT"))))
  (setq L (sslength BLKS))
  (setq L (- L 1))
  (setq I 0)
  (setq BLIST (list "BLOCK NAMES"))
  (setq BNUM (list "INSTANCES"))
  (while (<= I L)
     (setq ENAME (ssname BLKS I))
     (setq EDATA (entget ENAME))
     (setq BNAME (assoc 2 EDATA))
     (setq BNAME (cdr BNAME))
     (setq CHK (member BNAME BLIST))
     (if (eq CHK NIL)
        (setq BLIST (cons BNAME BLIST))
     ) ;_ end of if
     (setq I (+ I 1))
  ) ; end while
  (setq L1 (length BLIST))
  (setq L1 (- L1 2))
  (setq J 0)
  (setq N 0)
  (setq K 0)
  (while (<= K L1)
     (setq N 0)
     (setq BNAME1 (nth K BLIST))
     (setq J 0)
     (while (<= J L)
        (setq ENAME (ssname BLKS J))
        (setq EDATA (entget ENAME))
        (setq BNAME2 (assoc 2 EDATA))
        (setq BNAME2 (cdr BNAME2))
        (if (eq BNAME1 BNAME2)
           (setq N (+ N 1))
        ) ;_ end of if
        (setq J (+ J 1))
     ) ; end while j
     (setq BNUM (cons N BNUM))
     (setq K (+ K 1))
  ) ; end while k
;;; Formatting
  (setq K 0)
  (princ)
  (command "TEXTSCR")
  (princ "\nBlock Name     Instance")
  (while (<= K L1)
     (setq TEMP1 (nth K BLIST))
     (setq TEMP2 (nth (- L1 K) BNUM))
     (princ "\n")
     (princ TEMP1)
     (princ "\t\t\t")
     (princ TEMP2)
     (setq K (+ K 1))
  ) ; end while k
  (princ "\n\nPress the <F2> key to hide the text screen after viewing results... ")
  (princ)
) ;_ end of defun

;(princ
;   "\n         Blocklst loaded...  Start command by typing   BLOCKLST "

;(princ)

Lisp code 2: (COUNT SELECTED BLOCKS LAYER WISE)

(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))))
)
)

Thanks,

T.Brahmanandam

[pbejse · Accepted solution]

---

@Anonymous wrote:

Hi helpers, Need a small modification in lisp

Dear Helpers,

I have a lisp code that can count blocks in different layer. I need a modification like it can give blocks quantities in selected closed polylines which are in different layers.

I have two lisp codes now. Can anyone please help me to recode them.

Thanks,

T.Brahmanandam

---

Did you write the code yourself? 

(Defun c:demo (/ 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 "_X"
                  '((0 . "LWPOLYLINE") (8 . "ZONE*") (410 . "Model"))
           )
  )
  (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 "CP" (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)
)

[Anonymous]

Dear Sir,

Nothing is working with "demo" command when I load this lisp code to my autocad workspace. Can you please try again once. I am using 2014 version. It may cause something?

Regards,

T.Brahmanandam

[pbejse · Accepted solution]

---

@Anonymous wrote:

Nothing is working with "demo" command when I load this lisp code to my autocad workspace. Can you please try again once. I am using 2014 version. It may cause something?

---

Wow... really?

Try replacing this

(setq BlockCollection nil
         ss (ssget "_X"
                  '((0 . "LWPOLYLINE") (8 . "ZONE*") (410 . "Model"))
           )
  )

with

(setq BlockCollection nil
         ss (ssget '((0 . "LWPOLYLINE"))
           )
  )

[pbejse]

I should've known...

Galaxy far far away / Final frontier

[Anonymous · Accepted solution]

Thank you Sir,

The code is working fine. But it also counting, if the block insertion point is also outside. It should not count the blocks whatever just touching the boundary  and the insertion points are outside.

The code made by you is below for editing as per my request Sir.

(Defun c:demo (/ 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 "CP" (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)
)

[pbejse · Accepted solution]

Changing "CP" to "WP" will do that.

(setq blocksinside (ssget "CP" (Cdr data) '((0 . "INSERT"))))

to

(setq blocksinside (ssget "WP" (Cdr data) '((0 . "INSERT"))))

But listen, obviously, you are using the routine on some other file other than the one you posted. We here cannot thoroughly test a code just by guessing tnvsb. 

Post a more realistic sample if you can so won't be going back and forth and trying to figure out why it's "NOT WORKING" 

[Anonymous]

Thank you very much, It's working fine Sir.

[pbejse · Accepted solution]

---

@Anonymous wrote:

Thank you very much, It's working fine Sir.

---

Glad you had it sorted.

You are welcome

and DON'T call me sir, I work for a living 🙂

[Kent1Cooper · Accepted solution]

---

@pbejse wrote:

Changing "CP" to "WP" will do that.

(setq blocksinside (ssget "CP" (Cdr data) '((0 . "INSERT"))))

to

(setq blocksinside (ssget "WP" (Cdr data) '((0 . "INSERT"))))

---

....

Are you sure?  I believe that will not  find Blocks with their insertion points inside  the Polyline if they overlap it [because they're not fully inside the WP boundary], but I think @Anonymous [can you confirm?] wants  it to find those.

[Anonymous]

Thank you so much sir

[pbejse · Accepted solution]

---

@Kent1Cooper wrote: 

Are you sure?  I believe that will not  find Blocks with their insertion points inside  the Polyline if they overlap it [because they're not fully inside the WP boundary],....

---

That really was my question. That's why I wrote...

Post a more realistic sample if you can so won't be going back and forth and trying to figure out why it's "NOT WORKING" 

---

@Kent1Cooper wrote:
.... but I think @Anonymous [can you confirm?] wants  it to find those.

---

I had another code at the ready to do just that.

Sadly  tnvsb reply to all that is.

Thank you very much, It's working fine Sir.-

So..

. 

Thank you for the follow by the way 😄