Hi
Give this a shot
Change the table options to your suit
Code:
(defun make-tablestyle ( name desc txtstyle h1 h2 h3 / tblstyle adoc)
(or (vl-load-com))
(setq
tblstyle (vla-addobject
(vla-item (vla-get-dictionaries
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
)
"Acad_Tablestyle"
)
name
"AcDbTableStyle"
)
)
(setq acmCol (vla-getinterfaceobject
(vlax-get-acad-object)
(strcat "AutoCAD.AcCmColor."
(substr (getvar "ACADVER") 1 2))))
(vla-put-name tblstyle name)
(vla-put-headersuppressed tblstyle :vlax-false)
(vla-put-titlesuppressed tblstyle :vlax-false)
(vla-put-description tblstyle desc)
(vla-put-flowdirection tblstyle 0)
(vla-put-bitflags tblstyle 1)
(vla-put-horzcellmargin tblstyle (/ h3 5))
(vla-put-vertcellmargin tblstyle (/ h3 5))
(vla-settextstyle tblstyle 7 txtstyle)
;;; (vla-settextstyle tblstyle 4 txtstyle)
;;; (vla-settextstyle tblstyle 1 txtstyle)
(vla-settextheight tblstyle 1 h3)
(vla-settextheight tblstyle 4 h2)
(vla-settextheight tblstyle 2 h1)
(vla-setrgb acmCol 204 102 0)
;;; (vla-put-colorindex acmCol 32)
(vla-setgridcolor tblstyle 63 7 acmCol)
(vla-setgridvisibility tblstyle 63 7 :vlax-true)
(vla-setgridlineweight tblstyle 18 7 aclnwt009)
(vla-setgridlineweight tblstyle 45 7 aclnwt050)
(vlax-release-object acmCol)
)
;=========== * prepared part for block table creation * ===========;
(defun C:BTT (/ acmcol acsp adoc objtable axss blkid cnt col
columns desc desc_wid headers i lst_count
lst_name nm row rows ss table_data tmp)
(if (< (atof (getvar "ACADVER")) 16.0)
(alert "This routine will work\nfor versions A2005 and higher")
(progn
(alert "\tBe patience\n\tWorks slowly")
(vl-load-com)
(or adoc
(setq adoc (vla-get-activedocument
(vlax-get-acad-object))))
(or acsp (setq acsp (if (= (getvar "TILEMODE") 0)
(vla-get-paperspace
adoc)
(vla-get-modelspace
adoc))
)
)
(make-tablestyle "Block-Count" "Symbol table" "Standard" 10.0 10.0 12.0)
(setq acmCol (vla-getinterfaceobject
(vlax-get-acad-object)
(strcat "AutoCAD.AcCmColor."
(substr (getvar "ACADVER") 1 2))))
(setq dht (getvar "dimtxt"))
(setq ss (ssget "_X" '((0 . "INSERT"))))
(setq axss (vla-get-activeselectionset adoc))
(vlax-for a axss
(setq nm (vlax-get a 'Name))
(setq lst_name
(cons nm lst_name))
(if (not (member nm lst_count))
(setq lst_count (cons nm lst_count))))
(foreach i lst_count
(setq tmp (length (vl-remove-if-not (function (lambda (x)(eq x i))) lst_name))
desc (cdr (assoc 4 (entget (tblobjname "BLOCK" i))))
tmp (list i tmp (if (not desc) "No description for this symbol" desc) "")
table_data (cons tmp table_data)))
(setq desc_wid (* (getvar "dimtxt")(apply 'max (mapcar 'strlen (mapcar 'caddr table_data)))))
(setq columns (length (car table_data))
rows (length table_data)
)
(setq objtable (vlax-invoke
acsp
'Addtable
(getpoint "\nUpper left table insertion point: \n")
(+ 3 rows)
columns
;; rows height (change by suit):
(* dht 1.667);28
;; columns width (change by suit):
(* dht 8.333);50
)
)
(vla-put-regeneratetablesuppressed objtable :vlax-true)
(vla-put-layer objtable "0")
(vla-put-titlesuppressed objtable :vlax-false)
(vla-put-headersuppressed objtable :vlax-false)
(vla-put-horzcellmargin objtable (* dht 0.5))
(vla-put-vertcellmargin objtable (* dht 0.5))
(vla-settextstyle objtable 2 "Standard")
(vla-settextstyle objtable 4 "Standard")
(vla-settextstyle objtable 1 "Standard")
(vla-setrowheight objtable 2 (* dht 1.5))
(vla-setrowheight objtable 4 (* dht 1.25))
(vla-setrowheight objtable 1 (* dht 1.25))
(vla-settextheight objtable 2 (* dht 1.25))
(vla-settextheight objtable 4 dht)
(vla-settextheight objtable 1 dht)
(vla-put-colorindex acmcol 256)
(vla-put-truecolor objtable acmcol)
(vla-setcolumnwidth objtable 0 (* dht 10))
(vla-setcolumnwidth objtable 1 (* dht 5))
(vla-setcolumnwidth objtable 2 desc_wid)
(vla-setcolumnwidth objtable 3 (* dht 12))
(vla-put-colorindex acmcol 2)
(vla-settext objtable 0 0 "SYMBOL LIST") ;(change by suit)
(vla-setcelltextheight objtable 0 0 (* dht 1.5))
(vla-setcellcontentcolor objtable 0 0 acmcol)
(vla-put-colorindex acmcol 102)
(setq headers '("SYMBOL" "QTY" "EQUIPMENT DESCRIPTION" "REMARKS");(change by suit)
)
(setq col 0
row 1
)
(foreach a headers
(vla-settext objtable row col a)
(vla-setcelltextheight objtable row col (* dht 1.25))
(vla-setcellcontentcolor objtable row col acmcol)
(setq col (1+ col))
)
(vla-put-colorindex acmcol 40)
(setq lst_count (acad_strlsort (mapcar 'car table_data)) row 2 col 0)
(foreach i lst_count
(setq blkID (vla-get-objectid (vla-item (vla-get-blocks adoc) i)))
(vla-setblocktablerecordid objtable row col blkID :vlax-true)
(vla-setblockscale objtable row col 0.75)
(vla-setcellalignment objtable row col acMiddlecenter)
(vla-setcellcontentcolor objtable row col acmcol)
(setq row (1+ row)))
(setq cnt 1 row 2)
(foreach i (mapcar 'cdr table_data)
(setq col 1)
(foreach a i
(vla-settext objtable row col a)
(if (/= col 1)
(vla-setcellalignment objtable row col acMiddleLeft)
(vla-setcellalignment objtable row col acMiddleCenter))
(vla-setcellcontentcolor objtable row col acmcol)
(setq col (1+ col)))
(setq row (1+ row))
)
(vla-put-colorindex acmcol 12)
(vla-settext objtable row 2 "Total:")
(vla-setcellalignment objtable row 0 acMiddleLeft)
(vla-setcellcontentcolor objtable row 0 acmcol)
(vla-settext objtable row 3
(itoa (apply 'max (mapcar 'cadr table_data))))
(vla-setcellalignment objtable row 1 acMiddleCenter
)
(vla-setcellcontentcolor objtable row 1 acmcol)
(vla-put-regeneratetablesuppressed objtable :vlax-false)
(vl-catch-all-apply
(function
(lambda ()
(progn
(vla-clear axss)
(vla-delete axss)
(mapcar 'vlax-release-object (list axss objtable))
)
)
)
)
(vla-regen adoc acactiveviewport)
(alert "Done")
)
)
(princ)
)
(prompt
"\n\t\t\t |-----------------------------|\n"
)
(prompt
"\n\t\t\t <| Start with BTT to execute |>\n"
)
(prompt
"\n\t\t\t |-----------------------------|\n"
)
; TesT : (C:BTT)
~'J'~