mpk_bg Posted February 25, 2008 Share Posted February 25, 2008 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. Quote Link to comment Share on other sites More sharing options...
dbroada Posted February 25, 2008 Share Posted February 25, 2008 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. Quote Link to comment Share on other sites More sharing options...
Guest LElkins Posted February 25, 2008 Share Posted February 25, 2008 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 Quote Link to comment Share on other sites More sharing options...
mpk_bg Posted February 25, 2008 Author Share Posted February 25, 2008 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. Quote Link to comment Share on other sites More sharing options...
ASMI Posted February 25, 2008 Share Posted February 25, 2008 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 Quote Link to comment Share on other sites More sharing options...
VVA Posted February 26, 2008 Share Posted February 26, 2008 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 Quote Link to comment Share on other sites More sharing options...
fixo Posted February 26, 2008 Share Posted February 26, 2008 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'~ Quote Link to comment Share on other sites More sharing options...
mpk_bg Posted February 26, 2008 Author Share Posted February 26, 2008 sorry for the question but how to run that code ? Quote Link to comment Share on other sites More sharing options...
fixo Posted February 26, 2008 Share Posted February 26, 2008 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'~ Quote Link to comment Share on other sites More sharing options...
mpk_bg Posted February 26, 2008 Author Share Posted February 26, 2008 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'~ Quote Link to comment Share on other sites More sharing options...
fixo Posted February 26, 2008 Share Posted February 26, 2008 Try attached instead maybe problem is on formatting What is your Acad version? ~'J'~ CCB.zip Quote Link to comment Share on other sites More sharing options...
mpk_bg Posted February 26, 2008 Author Share Posted February 26, 2008 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. Quote Link to comment Share on other sites More sharing options...
fixo Posted February 26, 2008 Share Posted February 26, 2008 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'~ Quote Link to comment Share on other sites More sharing options...
mpk_bg Posted February 26, 2008 Author Share Posted February 26, 2008 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. Quote Link to comment Share on other sites More sharing options...
fixo Posted February 26, 2008 Share Posted February 26, 2008 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'~ Quote Link to comment Share on other sites More sharing options...
SLW210 Posted February 26, 2008 Share Posted February 26, 2008 I have a couple that will list by current layer. Quote Link to comment Share on other sites More sharing options...
mpk_bg Posted February 26, 2008 Author Share Posted February 26, 2008 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 Quote Link to comment Share on other sites More sharing options...
fixo Posted February 26, 2008 Share Posted February 26, 2008 I got it See you tomorrow ~'J'~ Quote Link to comment Share on other sites More sharing options...
fixo Posted February 26, 2008 Share Posted February 26, 2008 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'~ Quote Link to comment Share on other sites More sharing options...
william21864 Posted October 26, 2009 Share Posted October 26, 2009 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??!! Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.