;; free lisp from cadviet.

com
;; Altered by Greg Battin 1102011 for english use
;;Find replace 10 with 8
(defun cBlkQty ( 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))