script for counting blocks

is it possible using VBA or LISP script, to count number of blocks inside a polyline.

let's say we have 3 closed polylines, 1 for dinner room, 2 for bed room and 3 for WC.

in each polyline we have random number of blocks - Lamps.

so my question is, is it possible using scripts that can count those Lamp numbers, and export those numbers in excel spreadsheet like Attribute Extraction option.

Thank you.

do you want this all automatic or will you be selection the area from the screen? If you are doing the selection then the AutoCAD command BCOUNT will give you what you want. If you want it all done automatically I'm not sure how I would approach the problem.

I am sure I remember seeing a lsp that would delete everything outside of the polyline...anyone else remember this? got a link?

using this and the bcount command together (then of course oops) should give what you want, in an easy/dirty manner.

Will see what I can scrape together if I find that link.

Cheers

do you want this all automatic or will you be selection the area from the screen? If you are doing the selection then the AutoCAD command BCOUNT will give you what you want. If you want it all done automatically I'm not sure how I would approach the problem.

well im currently using some way of caounting blocks and trasfering data into ms excel spreasheet, but all i get is total count of blokcs, but my idea is to get number of blocks in more details, like position in diffrent apartments and rooms, which i dont know how to do with built-in menus in AutoCAD.

That's why i want to ask here for script solution of the problem.

May be try it...

(defun c:pls(/ plSet ptLst filLst nameLst curLen)

 (defun namesExtract(selSet)
   (mapcar '(lambda(x)(assoc 2 x))
    (mapcar 'entget(vl-remove-if 'listp
     (mapcar 'cadr(ssnamex selSet)))))
   ); end of namesExtract
 
 (princ"\n<<< Select polyline >>> ")
 (if
   (and
     (setq plSet
  (ssget "_:S" '((0 . "LWPOLYLINE"))))
      (setq ptLst
       (mapcar
 '(lambda(x)(trans x 0 1))
 (mapcar 'cdr
   (vl-remove-if-not
    '(lambda(x)(= 10(car x)))
      (entget
        (ssname plSet 0))))))
     ); end and
   (progn
   (if(setq plSet(ssget "_CP" ptLst '((0 . "INSERT"))))
     (progn
     (sssetfirst nil plSet)
      (setq nameLst(namesExtract plSet))
   (princ "\n========== COUNT REPORT ==========")
   (while nameLst
     (setq curLen(length nameLst))
     (princ(strcat "\n" (cdar nameLst) " "
		  (itoa(- curLen(length(setq nameLst
		    (vl-remove(car nameLst)nameLst)))))))
     ); end while
   (princ "\n=========== END REPORT ===========\n")
   (textscr)
   ); end progn
 ); end if
     ); end progn
    (princ "\nNothing found  ")
   );end if
 (princ)
 ); end of c:pls

Variant with counting dynamic block

(defun c:pls(/ plSet ptLst filLst nameLst curLen)
 (vl-load-com)
 (defun namesExtract(selSet)
   (mapcar '(lambda(blk)
        (if (and (vlax-property-available-p blk 'isdynamicblock)
   (= (vla-get-isdynamicblock blk) :vlax-true)
   ) ;_ end of and
   (vla-get-effectivename blk) 
          (vla-get-name blk)
   )
       )
    (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp
     (mapcar 'cadr(ssnamex selSet))))
    )
   ); end of namesExtract
 
 (princ"\n<<< Select polyline >>> ")
 (if
   (and
     (setq plSet
  (ssget "_:S" '((0 . "LWPOLYLINE"))))
      (setq ptLst
       (mapcar
 '(lambda(x)(trans x 0 1))
 (mapcar 'cdr
   (vl-remove-if-not
    '(lambda(x)(= 10(car x)))
      (entget
        (ssname plSet 0))))))
     ); end and
   (progn
   (if(setq plSet(ssget "_CP" ptLst '((0 . "INSERT"))))
     (progn
     (sssetfirst nil plSet)
      (setq nameLst(namesExtract plSet))
   (princ "\n========== COUNT REPORT ==========")
   (while nameLst
     (setq curLen(length nameLst))
     (princ(strcat "\n" (car nameLst) " "
    (itoa(- curLen(length(setq nameLst
      (vl-remove(car nameLst)nameLst)))))))
     ); end while
   (princ "\n=========== END REPORT ===========\n")
   (textscr)
   ); end progn
 ); end if
     ); end progn
    (princ "\nNothing found  ")
   );end if
 (princ)
 ); end of c:pls

Here is another one with temporary dialog

Hit Help button to see how it works

(defun make-blocks-dial ()
;;;(setq fname (vl-filename-mktemp "countblocksA.dcl"))
(setq fname (strcat (getvar "dwgprefix") "countblocksWH.dcl")) 
(setq fn (open fname "w"))
(write-line "countblocks : dialog {"  fn)
(write-line (strcat "label = " "\""  "COUNT BLOCKS" "\"" ";") fn)
(write-line "spacer;" fn)
(write-line ": column {" fn)
(write-line ": text_part {" fn)
(write-line (strcat "label = " "\""  "   Select Block To Get Quantity" "\"" ";") fn)
(write-line "fixed_width_font = true;}" fn)
(write-line "spacer;" fn)
(write-line ": list_box {" fn)
(write-line (strcat "key = " "\"" "blks" "\"" ";")  fn)
(write-line "edit_width = 16; fixed_width_font = true;}" fn)
(write-line ": boxed_column {" fn)
(write-line ": row {" fn)
(write-line ":edit_box {" fn)
(write-line (strcat "label = " "\""  "Total Blocks Count: " "\"" ";") fn)
(write-line (strcat "key = " "\"" "total" "\"" ";")  fn)
(write-line "edit_width = 6; fixed_width_font = true;}" fn)
(write-line (strcat ": text { label = " "\"" "                                      " "\"" ";}") fn)
(write-line "edit_width = 24;}" fn)
(write-line "spacer;" fn)
(write-line ": popup_list {" fn)
(write-line "popup_height = 8;" fn)
(write-line (strcat "label = " "\""  "Select Layout: " "\"" ";") fn)
(write-line (strcat "key = " "\"" "layts" "\"" ";")  fn)  
(write-line (strcat "value = " "\"" " " "\"" ";") fn)
(write-line "edit_width = 24; fixed_width_font = true;}" fn)
(write-line "spacer;" fn)
(write-line ": row {" fn)
(write-line ":edit_box {" fn)
(write-line (strcat "label = " "\""  "Blocks On Layout: " "\"" ";") fn)
(write-line (strcat "key = " "\"" "count" "\"" ";")  fn)
(write-line "edit_width = 6; fixed_width_font = true;}" fn)
(write-line (strcat ": text { label = " "\"" "                                   " "\"" ";}}") fn)  
(write-line "spacer;} }" fn)  
(write-line "spacer;" fn)
(write-line "ok_cancel_help;" fn)
(write-line "}" fn)  
(close fn)
)


(defun run-blocks-dial () 
(setq dcl_ex (load_dialog fname))
(new_dialog "countblocks" dcl_ex)
  (setq blocks (acad_strlsort (Table "block")))
  (start_list "blks")
  (mapcar ' add_list blocks)
  (end_list)
  (setq layouts (append (list "Model")(layoutlist)))
  (start_list "layts")
  (mapcar ' add_list layouts)
  (end_list)
  (action_tile "blks" "(setq bname (nth (atoi $value) blocks))(set_tile \"total\" (itoa (cdr (countblockstotal  bname))))(set_tile \"count\" \"\")")
	  
 (action_tile "layts" "(setq layt (nth (atoi $value) layouts))(set_tile \"count\" (itoa (caddr (countblocksonpage  bname layt))))")


(action_tile "help" "(helpmessage)")
  (action_tile "cancel"
    "(done_dialog) (setq userclick nil)"
)

  (action_tile "accept" "(setq subtotal (atof (get_tile \"count\")))(done_dialog)(setq userclick T)")

  (setq check (start_dialog))
  (unload_dialog dcl_ex)
 
)
;Written By Michael Puckett.
(defun Table (s / d r)
(while (setq d (tblnext s (null d)))
(setq r (append r (list (cdr (assoc 2 d)))))
)
)

; written by Fatty 2008 () * all rights removed
(defun countblocksonpage (bname page / ss)
 (vl-load-com)
 (if (setq
ss (ssget "X"
	  (list (cons 2 (strcat bname ",`*U*")) (cons 410 page))
   )
     )
   (progn
   (mapcar
     (function
(lambda	(en)
  (if
    (not
      (eq (strcase bname)
	  (strcase
	    (vla-get-effectivename (vlax-ename->vla-object en))
	  )
      )
    )
     (ssdel en ss)
  )
)
     )
     (mapcar 'cadr (ssnamex ss))
   )
   (setq info (list bname page (sslength ss)))
 )
(setq info (list bname page 0)
 )
   )
 info
 )
(defun countblockstotal (bname / ss)
 (vl-load-com)
 (if (setq
ss (ssget "X"
	  (list (cons 2 (strcat bname ",`*U*")))
   )
     )
   (progn
   (mapcar
     (function
(lambda	(en)
  (if
    (not
      (eq (strcase bname)
	  (strcase
	    (vla-get-effectivename (vlax-ename->vla-object en))
	  )
      )
    )
     (ssdel en ss)
  )
)
     )
     (mapcar 'cadr (ssnamex ss))
   )
   (setq info (cons bname (sslength ss)))
 )
(setq info (cons bname 0)
 )
   )
 info
 )

(defun helpmessage ()
(alert 
(strcat
"                                       How It Works:.\n"
"------------------------------------------------------------------------------------------ \n"
"Select a block from the list box\n"
"The text box below contains the total number of blocks in all drawing layouts.\n" 
"Select the required layout from the combo box to acquire the amount of block\n"
"instances in that layout- The highlighted selection will turn blue on selection.\n"
"Once again the text box below contains the total number of blocks in the layout\n"
"selected.\n" 
"To Copy a number of blocks on a selected layout, simply \"right click\" or\n"
"\"double click\" within the text box -> choose \"copy\" from the drop down menu.\n"
"\n" 
"The text can then be placed (\"pasted\") in a number of applications such as\n"
"Excel, Word, AutoCad etc.\n"
"------------------------------------------------------------------------------------------ \n"
"                                         Happy computing,                                 \n"
"                                       Fatty The Old Horse                                \n"
"------------------------------------------------------------------------------------------ \n"
     )
     )
)

(defun C:CCB(/ *error* dcl_id)
(or (vl-load-com))
(defun *error*  (msg)
   (cond
     ((or (not msg)
   (member msg
	   '("console break"
	     "Function cancelled"
	     "quit / exit abort"))))
((eq msg "Unknown command \"VLIDE\" ")
 (alert "\nCheck syntax of last command ! \n"));stuff for debug only
     (T (princ (strcat "\nError: " msg)))
     ) 
 (setvar "cmdecho" 1)  
 (princ)
 )
 (setvar "cmdecho" 0)
 (make-blocks-dial)
 (run-blocks-dial)
 (*error* nil)
 (princ)
 )
 (princ "\n\t***\t\Fatty T.O.H () 2008 * all rights removed\t***")
 (princ "\n\t\t\t***\t\Start command with CCB\t***")
 (princ)

~'J'~

sorry for the question but how to run that code ?

Take a look at this page:

http://www.cadtutor.net/faq/questions/28/How+do+I+use+an+AutoLISP+routine%3F

~'J'~

yeah i ran the scripts above yours in that way, but when running this one with CCB on command linei get :

Unknown command "CCB". Press F1 for help.

Take a look at this page:

 

http://www.cadtutor.net/faq/questions/28/How+do+I+use+an+AutoLISP+routine%3F

 

~'J'~

Try attached instead maybe problem

is on formatting

What is your Acad version?

~'J'~

CCB.zip

it is working now.

this is great good looking way of counting blocks, but i really need something diffrent for me so i can get around quickly with counting blocks in many diffrent polylines in Layout space.

the first script was almost what i need, with one little update if it is possible, i want the blocks and their counts to be exctracted into a Excel spreadsheet in diffrent cells, one for block's name and another one for block's count.

and a visual menu for typing the excel file name which the data is transfered into.

thanks guys you are making a big help for me.

Try this one to export all blocks to Excel

Not clearly enough for me what you mean:

>>counting blocks in many diffrent polylines in Layout space

Do you mean to count blocks inside of any closed

polygons in the different Layouts or what?

;; Helper function 'count-blocks'

;; written by Fatty T.O.H. () 2005 * all rights removed
(defun count-blocks (/ acsp adoc bname bname_list tmp_list ss tmp)
 (vl-load-com)
 (setq	adoc (vla-get-activedocument
       (vlax-get-acad-object)
     )
acsp (vla-get-block
       (vla-get-activelayout adoc)
     )
 )
 (command "_.zoom" "_e")
 (setq	ss (ssget "_X"
	  (list (cons 0 "INSERT") ;|(cons 2 "block1,block2,block3")|;your desired block names here
   )
 )
 (vlax-for a (vla-get-activeselectionset adoc)
   (if	(wcmatch (vla-get-objectname a) "AcDbBlockReference*")
     (progn
(setq bname (vla-get-name a))
(setq bname_list (cons bname bname_list))
     )
   )
 )
 (while (car bname_list)
   (setq tmp (list (vl-remove-if-not
	      (function	(lambda	(a)
			  (eq a (car bname_list))
			)
	      )
	      bname_list
	    )
      )
   )
   (setq tmp_list (cons (car tmp) tmp_list))
   (setq bname_list
   (vl-remove-if
     (function (lambda (a)
		 (eq a (car bname_list))
	       )
     )
     bname_list
   )
   )
   (setq tmp nil)
 )

 (setq	tmp_list	(mapcar	(function (lambda (x)
			    (list (car x) (length x))
			  )
		)
		(reverse tmp_list)
	)
 )

 tmp_list
)
;CaLL:(count-blocks);ok

;; 		Main program			;

;;; Based on program 'Excel' written by
;;; ALEJANDRO LEGUIZAMON - arquingeneu@gmail.com
;;; edited by Fatty

(defun c:cbl (/ LAYER# LIST# N ROW TOTALVALUE VALUE)

 (vl-load-com)
 (setq	*AplExcel*	   (vlax-get-or-create-object "Excel.application")
*Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
*New-Book*	   (vlax-invoke-method *Books-Colection* "Add")
*Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
*Sheet#1*	   (vlax-get-property *Sheet-Collection* "Item" 1)
*excell-cells*	   (vlax-get-property *Sheet#1* "Cells")
 )
 (vla-put-visible *AplExcel* :vlax-true)
 (setq row 4)
 (setq n 0)
 (setq totalvalue 0)
 (princ "\nCOUNTING BLOCKS IN DRAWING")
 (setq list# (count-blocks))

 (setq totalvalue (apply '+ (mapcar 'cadr list#)))
 (repeat (length list#)
   (setq value (cadar list#))
   (vlax-put-property
     *excell-cells*
     "Item"
     row
     2
     (vl-princ-to-string value)
   )

   (setq layer# (caar list#))
   (vlax-put-property
     *excell-cells*
     "Item"
     row
     1
     (vl-princ-to-string layer#)
   )
   (setq list# (cdr list#))
   (setq n (+ n 1))
   (setq row (+ row 1))
 )

 (setq row (+ row 1))
 (vlax-put-property
   *excell-cells*
   "Item"
   row
   1
   (vl-princ-to-string "TOTAL")
 )

 (vlax-put-property
   *excell-cells*
   "Item"
   row
   2
   (vl-princ-to-string totalvalue)
 )

 (vlax-put-property
   *excell-cells*
   "Item"
   1
   1
   (vl-princ-to-string
     " Based on routine by  ALEJANDRO LEGUIZAMON -  http://arquingen.tripod.com.co"
   )
 )

 (vlax-put-property
   *excell-cells*
   "Item"
   2
   1
   (vl-princ-to-string
     (strcat "COUNTING BLOCKS IN DRAWING: " (getvar "dwgprefix"))
   )
 )
 (vlax-put-property
   *excell-cells*
   "Item"
   3
   1
   (vl-princ-to-string "Block name")
 )
 (vlax-put-property
   *excell-cells*
   "Item"
   3
   2
   (vl-princ-to-string "Subtotal")
 )

 (vlax-release-object *excell-cells*)
 (vlax-release-object *Sheet#1*)
 (vlax-release-object *Sheet-Collection*)
 (vlax-release-object *New-Book*)
 (vlax-release-object *Books-Colection*)
 (vlax-release-object *AplExcel*)
 (alert "Save Excel file manually")
)

(prompt "\nType CBL to execute ...")
(princ)

~'J'~

nice,

by saying multiple polylines i mean that on my layout i have many closed polylines in which there are diffrent blocks.

every polyline is presenting an apartment area, blocks are lamps, furniture and etc.

i need to exctract those blocks numbers coresponding to their names into a specification for each apartment into a excel spreadsheet.

let's say i have polyline in layer A1 presenting apartment A1, polyline in layer A2 presenting apartment A2 and so on, is there are way to get blocks numbers inclosed by polyline A1, A2 ... An, and have them in excel sheet?

but on my DWG file i have other polylines except those presenting apartments, so i want to select manual exactly those polylines which are apartments areas.

i can upload a DWG file with those polylines if needed.

Sorry I can't imagine that, it's to difficult

for my dim brain

Better yet attach your sample, say 2-3 appartments

to see this situation completely

~'J'~

I have a couple that will list by current layer.

Here it is a sample DWG file, i have also put a sample excel table, hope this will help me explain you better what i want.

sry the file is not shared here but it is over 1MB

http://files.filefront.com/exampledwg/;9709368;/fileinfo.html

I got it

See you tomorrow

~'J'~

Huh, now is tomorrow

 
;; local defun 'count-blocks-in-set'

;; written by Fatty(c) 2008 * all rights removed
(defun count-blocks-in-set (axss / acsp adoc bname bname_list tmp_list ss tmp)

 (vlax-for a axss
   (if	(wcmatch (vla-get-objectname a) "AcDbBlockReference*")
     (progn
(if
(eq :vlax-false (vla-get-isdynamicblock a))
(setq bname (vla-get-name a))
(setq bname (vla-get-effectivename a))
)
(setq bname_list (cons bname bname_list))
     )
   )
 )
 (while (car bname_list)
   (setq tmp (list (vl-remove-if-not
	      (function	(lambda	(a)
			  (eq a (car bname_list))
			)
	      )
	      bname_list
	    )
      )
   )
   (setq tmp_list (cons (car tmp) tmp_list))
   (setq bname_list
   (vl-remove-if
     (function (lambda (a)
		 (eq a (car bname_list))
	       )
     )
     bname_list
   )
   )
   (setq tmp nil)
 )

 (setq	tmp_list	(mapcar	(function (lambda (x)
			    (list (car x) (length x))
			  )
		)
		(reverse tmp_list)
	)
 )

 tmp_list
)

;; local defun 'get-blocks-qty'
(defun get-blocks-qty (/ acsp	    adoc       axss	  bcount_data
		 bcount_list	       en	  layer_name
		 ptlist	    ss	       ssb
		)
         (or (vl-load-com))
         (setq	adoc (vla-get-activedocument
	       (vlax-get-acad-object)
	     )
	acsp (vla-get-block
	       (vla-get-activelayout adoc)
	     )
	)
 (alert "Select floor plan by window\nor all contours you need\nseparately one by another")
 (setq ss (ssget (list (cons 0 "LWPOLYLINE")(cons 8 "apt.*"))))
 (while (setq en (ssname ss 0))
   (setq ptlist (vl-remove-if
	   (function not)
	   (mapcar (function (lambda (x)
			       (if (= 10 (car x))(cdr x))))
		   (entget en)))
  layer_name (cdr (assoc 8 (entget en)))
  
  )

(if (setq ssb (ssget "_WP" ptlist (list (cons 0 "INSERT"))))
    (progn
(setq 	axss (vla-get-activeselectionset adoc)
  )

    (setq bcount_list (append (list layer_name) (count-blocks-in-set axss))
   )
    (setq bcount_data (cons bcount_list bcount_data)
   )
    (setq bcount_list nil)
      )
  )
   (ssdel en ss)
   )
bcount_data
)
;; 		Main program			;
(defun C:APT (/	*Aplexcel*     *Books-Colection*
	*Columns*      *Excell-Cells* *New-Book*
	*Sheet#1*      *Sheet-Collection*
	*Used-Range*   Apt_Data	      Apt_Name
	Bcount_Data    Bname	      Col
	Data	       Inc	      Qty
	Row
       )
 
(setq data (get-blocks-qty)
     inc 1)
 

;;; Based on program 'Excel' written by
;;; ALEJANDRO LEGUIZAMON - arquingeneu@gmail.com
;;; edited by Fatty
 (setq	*AplExcel*	   (vlax-get-or-create-object "Excel.application")
*Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
*New-Book*	   (vlax-invoke-method *Books-Colection* "Add")
*Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
*Sheet#1*	   (vlax-get-property *Sheet-Collection* "Item" 1)
*excell-cells*	   (vlax-get-property *Sheet#1* "Cells")
 )
 (vla-put-visible *AplExcel* :vlax-true)
(repeat (length data)
 (setq apt_data (car data))
 (setq apt_name (car apt_data))
 
 
 (setq bcount_data (cdr apt_data))
 (setq bcount_data
 (vl-sort bcount_data
	  (function (lambda (a b)(< (car a)(car b)))))
)
 (setq bcount_data (append (list (list "Block Name" "Block Count")) bcount_data)
)
 ;;; write header
 (setq row 1)
 (vlax-put-property
     *excell-cells*
     "Item"
     row
     inc
     (vl-princ-to-string apt_name)
   )
 (foreach tmp bcount_data
   (setq row (1+ row))
   (setq col inc)
   (setq bname (car tmp)
  qty (cadr tmp)) 
   
 ;;;write block name
     (vlax-put-property
     *excell-cells*
     "Item"
     row
     col
     (vl-princ-to-string bname)
   )
   (setq col (1+ col))
 ;;; write quantity
   (vlax-put-property
     *excell-cells*
     "Item"
     row
     col
     (vl-princ-to-string qty)
   )
 )
   
 (setq data (cdr data)
inc (+ inc 3)
)
   )
 (setq *used-range* (vlax-get-property *Sheet#1* "UsedRange"))
 (setq *columns* (vlax-get-property *used-range* "Columns"))
 (vlax-invoke-method *columns* "AutoFit")
 (vlax-release-object *columns*)
 (vlax-release-object *used-range*)
 (vlax-release-object *excell-cells*)
 (vlax-release-object *Sheet#1*)
 (vlax-release-object *Sheet-Collection*)
 (vlax-release-object *New-Book*)
 (vlax-release-object *Books-Colection*)
 (vlax-release-object *AplExcel*)
 (alert "Save Excel file manually")
)
(prompt "\nType APT to execute ...")
(princ)

~'J'~

I have been using the lisp routine from VVA (defun c:pls ...... ) very successfully for counting blocks inside of a closed polyline boundary ( which helps us with devices inside of Zones assignments ) ... my boss just recently asked if there was away to "add" the ability to report not only the dynamic block but also the arribute as well ( without losing the ability to select within the polyline ) ... I thought if I asked nicely maybe VVA would update the great routine ... please??!!