AutoLISP: Block Count With A Table

As I promised in an earlier post, here is the block counter that places a table with a preview of the block within the table. An additional feature is to specify the text size of the text within the table which gives you extra control over the size of the table (notice that I set the text style to 4″ instead of the default 6″).

Also note that to load the lisp, I just drag & dropped it into the drawing area.

  • BLKQTY <enter> to start
  • Select blocks by either individual picks or with a window selection.
  • <enter> to accept the selection set.
  • Specify text height: default is 6″
  • Place table


;; free lisp from cadviet.com
;; Altered by Greg Battin 1/10/2011 for english use
;;Find replace 10 with 8
(defun c:BlkQty (/ blk_id blk_len blk_name blks ent h header_lsp height i j TOTAL
		len0 lst_blk msp pt row ss str tblobj width width1 width2 x y
)
;;  By : Gia Bach, gia_bach @  www.CadViet.com
;;
(vl-load-com)
(defun TxtWidth (val h msp / txt minp maxp)
  (setq	txt (vla-AddText msp val (vlax-3d-point '(0 0 0)) h))
  (vla-getBoundingBox txt 'minp 'maxp )
  (vla-Erase txt)
  (-(car(vlax-safearray->list maxp))(car(vlax-safearray->list minp)))  )
(defun GetOrCreateTableStyle (tbl_name / name namelst objtblsty objtblstydic tablst txtsty)
  (setq objTblStyDic (vla-item (vla-get-dictionaries *adoc) "ACAD_TABLESTYLE") )  
  (foreach itm (vlax-for itm objTblStyDic
		(setq tabLst (append tabLst (list itm))))
    (if (not
	  (vl-catch-all-error-p
	    (setq name (vl-catch-all-apply 'vla-get-Name (list itm)))))
      (setq nameLst (append nameLst (list name)))  )  )
  (if (not (vl-position tbl_name nameLst))
    (vla-addobject objTblStyDic tbl_name "AcDbTableStyle"))
  (setq objTblSty (vla-item objTblStyDic tbl_name)
	TxtSty (variant-value (vla-getvariable *adoc "TextStyle")))
  (mapcar '(lambda (x)(vla-settextstyle objTblSty x TxtSty))
	      (list acTitleRow acHeaderRow acDataRow) )
  (vla-setvariable *adoc "CTableStyle" tbl_name) )
(defun GetObjectID (obj)
  (if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
    (vlax-invoke-method *util 'GetObjectIdString obj :vlax-false )
    (vla-get-Objectid obj)))  
;main
  (if (setq ss (ssget (list (cons 0 "INSERT"))))
    (progn
      (vl-load-com)
      (setq i -1 len0 8)
      (while (setq ent (ssname ss (setq i (1+ i))))
	(setq blk_name (cdr (assoc 2 (entget ent))))
	(if (> (setq blk_len (strlen blk_name)) len0)
	  (setq str blk_name len0 blk_len) )	
	(if (not (assoc blk_name lst_blk))
	  (setq lst_blk (cons (cons blk_name 1) lst_blk))
	  (setq lst_blk (subst (cons blk_name (1+ (cdr (assoc blk_name lst_blk))))
			       (assoc blk_name lst_blk) lst_blk)))	    )
      (setq lst_blk (vl-sort lst_blk '(lambda (x y) (< (car x) (car y)) ) ))
      (SETQ TOTAL 0)
      (FOREACH I LST_BLK (SETQ TOTAL (+ TOTAL (CDR I))))
      (or *h* (setq *h* (* (getvar "dimtxt")(getvar "dimscale"))))
      (initget 6)
      (setq h (getreal (strcat "\nText Height <" (rtos *h*) "> :")))      
      (if h (setq *h* h) (setq h *h*) )
      (or *adoc (setq *adoc (vla-get-ActiveDocument (vlax-get-acad-object))))
      (setq msp (vla-get-modelspace *adoc)
	    *util (vla-get-Utility *adoc)
	    blks (vla-get-blocks *adoc))      
      (setq width1 (* 4 (TxtWidth "    " h msp))
	    width (* 2 (TxtWidth "Text Height" h msp))
	    height (* 2 h))
      (if str
	(setq width2 (* 1.5 (TxtWidth (strcase str) h msp)))
	(setq width2 width))
      (if (> h 3)
	(setq width (* (fix (/ width 8))8)
	      width1 (* (fix (/ width1 8))8)
	      width2 (* (fix (/ width2 8))8)
	      height (* (fix (/ height 5))5)))
      (GetOrCreateTableStyle "CadEng")
      (setq pt (getpoint "\nPlace Table :")
	    TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 3) 4 height width));CHANGE 5 TO 4
      (vla-put-regeneratetablesuppressed TblObj :vlax-true)
      (vla-SetColumnWidth TblObj 0 width1)
      (vla-SetColumnWidth TblObj 1 width2)
      (vla-put-vertcellmargin TblObj (* 0.75 h))
      (vla-put-horzcellmargin TblObj (* 0.75 h))
      (mapcar '(lambda (x)(vla-setTextHeight TblObj x h))
	      (list acTitleRow acHeaderRow acDataRow) )
      (mapcar '(lambda (x)(vla-setAlignment TblObj x 8))
	      (list acTitleRow acHeaderRow acDataRow))      
      (vla-MergeCells TblObj 0 0 0 3);change 4 to 3
      (vla-setText TblObj 0 0 "Block Count Table")
      (setq j -1 header_lsp (list "    " "Block Name" "Quantity" "Preview"));;;;;;;;;;;;;;;;;;;;;;REMOVE "DON VI"
      (repeat (length header_lsp)
	(vla-setText TblObj 1 (setq j (1+ j)) (nth j header_lsp)))
      (setq row 2 i 1)    
      (foreach pt lst_blk
	(setq blk_name (car pt) j -1)
	(mapcar '(lambda (x)(vla-setText TblObj row (setq j (1+ j)) x))
		(list i blk_name  (cdr pt)));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;REMOVE "CAI"
	(vla-SetBlockTableRecordId TblObj row 3 (GetObjectID (vla-item blks blk_name)) :vlax-true);CHANGE 4 TO 3
	(vla-SetCellAlignment TblObj row 1 7)
	(vla-SetCellAlignment TblObj row 2 9);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;CHANGE 3 TO 2
	(setq row (1+ row) i (1+ i))	)
        (VLA-SETTEXT TBLOBJ ROW 1 "TOTAL")
        (VLA-SETTEXT TBLOBJ ROW 2 TOTAL)
	(vla-SetCellAlignment TblObj row 1 7)
	(vla-SetCellAlignment TblObj row 2 9)
      (vla-put-regeneratetablesuppressed TblObj :vlax-false)
      (vlax-release-object TblObj) )  )
  (princ))
Advertisements

About AutoCAD Tips

This blog serves as a knowledge base for myself (and anyone else) so that I can reference tips & tricks that I have learned and also refer others to it as well. I hope that this blog helps you learn at least one tip to make your drafting/design experience better.
This entry was posted in AutoLISP, Blocks, TIPS. Bookmark the permalink.

33 Responses to AutoLISP: Block Count With A Table

  1. JAMES says:

    THE COD ISNT WORKING, JUST SAY ERROR MALFORMED LIST ON INPUT

    • AutoCAD Tips says:

      I updated it. You may run into this frequently with LISP code that you find from the internet. This program uses Visual LISP which uses Active X functions. You can tell this by all of the “VL….” at the beginning of commands and functions. So all that I did is add (vl-load-com) at the beginning of the code. This lets AutoLISP load Visual LISP/Active X functions. It should work now.
      Also, if you are familiar with your AutoCAD “Support” folder, you may have a file in there called “acad.lsp.” What many people who use LISP a lot do is add the little snippet “(vl-load-com) to their acad.lsp file so that when ever AutoCAD is opened and the acad.lsp file is loaded, it automatically loads the Active X functions and lets you use Visual LISP code.
      So in short, When you see VL’s in code from the internet and you don’t see (vl-load-com), go ahead and add it to the code. You can do this on any new line of code. It doesn’t hurt to put it in multiple times but once is good. And preferably near the top.

      • james says:

        still nothing, i used vlide to and found a missing parenthesis but now it spits this out ; error: bad variable name in SETQ: (SETQ LST_BLK (VL-SORT
        LST_BLK (QUOTE (LAMBDA (X Y) (< (CAR X) (CAR Y))))))

    • Jurij Ivanov says:

      That works great for me … Its amaizing … very very useful .. Thanks alllllot ..
      Was wandering if it is possible to generate additional data to this table… I meen it would be just great if there would be additional column with block external dimensions (lenth, width, feight) …
      Once again thanks …

      P.S. (Sorry for my English)

  2. Brendan says:

    Hi, I got the same error also.

    ; error: malformed list on input

    Adding (vl-load-com) to the acad.lsp, didn’t help

    Thanks for showing us a great lsp, one I would find extremely useful if it worked. :-(

  3. Joao Pereira says:

    Hi,

    I was searching some lisps to use in my autocad and this one seems very, very usefull. I’ve used the code posted here but it seems that I have the same problem that was posted previously, namly:”error: malformed list on input..” Is it possible to receive the working lisp?

    Thanks,
    JPP

  4. Kossiwa says:

    Hello Greg!!
    Thanks for this useful blog!! it is with cadtutor the site I visit daily!!!
    Can you send me the updated version of this lisp?
    Thanks very much and be blessed!

  5. Nathan says:

    Is there a way that such a lisp can also list attribute data in the table it creates? I am a landscape designer and I have thousands of plant symbol blocks in a planting plan and i need to list in a table, each block with multiple associated attributes such as plant size, water requirements, latin name, common name, etc. Any ideas on how to accomplish this in a single command?

    • AutoCAD Tips says:

      Believe me – I have looked for an easy way to extract Attribute info. Because there are so many variables to weed through, the easiest way to extract data is through the DATAEXTRACTION command or simply DX. This will allow you to specify what tags to extract and what blocks to extract from and will allow you to place a table into the drawing area and/or create an excel spreadsheet. I have posted about both creating and extracting attribute info HERE. I hope this helps.

  6. junbone says:

    THANK YOU FOR THIS VERY NICE AND USEFUL LSP. ITS A GREAT HELP FOR ELECTRICAL ENGINEER LIKE ME FOR COUNTING QTY. THANK YOU SO MUCH GREG.

    I HAVE ONE REQUEST IF YOU CAN MAKE A LISP FOR UNDEFINED BLOCKS TO MAKE IT FILTERABLE AGAIN LIKE *U### (*U235).

    AGAIN THANK YOU….

  7. Phan Tung says:

    Thank so much but it’s not work for me, it just make a table and doesn’t have any content inside, can you help me to fix it

  8. Scorp says:

    Hi Greg,

    I copied the code and tried to run it but I’m getting an error when I try to place the table as follows.

    Place Table : ; error: Automation Error. Invalid input

    Can you please tell me where the problem is?

    Appreciate your help and your code.

    -Scorp

  9. fernando martinez says:

    ..hello all..

    i have the same problem what Scorp.. Place Table : ; error: Automation Error. Invalid input

    what will be the problem??

    thanks guys..

    Fernando

  10. Hello! I would find this very useful, could you send me the lisp file?

    Thanks,
    Steve

  11. Sasha Vakurov says:

    Hi! this is a great lisp! you’re a genius! please send to vakamanboy@mail.ru. I will be very grateful. thanks

  12. Kesh says:

    HI! Thanks man. It is very very very good

  13. i have a mistake such as “Automation Error. Invalid input” what`s a reason of it. One more question is about if your programm works with any blocks or not

  14. I`ve found a problem! It`s amazing…Your programm works as well as i nedd but only in autocad not i often use a autocad mep.It doesn`t work in mep
    .

  15. ARASH says:

    HI,, I USED YOUR LISP BUT IT DOESN’T WORK CORRECTLY.. IT JUST SHOWS TABLE.. AN EMPTY TABLE
    WHAT CAN I DO TO FIXING IT?

  16. Jon says:

    Thank you, I have had a tool like this in the past and found it very useful. Happy to have it again.

  17. Ram says:

    Hello Greg,
    This is a fine piece of code. Can you help me by adding a filter or a nested table showing the breakup of the blocks by layers? I have the same block I color code and use in multiple places and am interested in the block that’s on a couple of specific layers. Your assistance is much appreciated.

    Thank you,
    Ram

  18. john says:

    Is there a way to use the FIND command and have its ‘total found’ value captured for a number of strings?

    For instance, I have MLEADERS with values from 1-100, and various quantity for each value (five MLEADERS with the number 7 in them, etc…) and I usually use the find command and look for the number 7 while all mleaders are selected and it comes back and says 5.

    I would like to automate that with a script… any recommendations?

  19. Iliyana says:

    Thank you for the cool program!! I run the program but the table don’t want to appear. I will be very thankfull, if someone say me where is the bug

  20. kim says:

    thak you for this amazing lisp

  21. Sam A Moryoussef says:

    Is there a way to have the table update if you add/subtract blocks in a drawing without having to make a new table every time? Otherwise this is really useful, thanks.

  22. PhY says:

    Good for me on AutoCAD 2018 :-)
    Thanks !

  23. RANA says:

    HOW TO USED blkqty IN DRAWING

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s