TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: cmwade77 on September 11, 2020, 12:03:23 PM
-
Ok, I know somewhere I had found a post on creating a table style from scratch using LISP, but I cannot find it now, anyone know where it might be or have an example of how to create a table style using LISP?
I know I could go the block route, but I am trying to avoid doing that if I can.
-
;;;;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/create-a-new-table-style-with-modified-title-header-and-data/td-p/7123088
(defun C:MakeTableStyle ()
(setq Table_Name "MyTable")
(setq Acad_Obj (vla-get-activedocument (vlax-get-acad-object)))
(setq Acad_Dict (vla-get-dictionaries Acad_Obj))
(setq Table_Dict (vla-item Acad_Dict "ACAD_TABLESTYLE"))
(setq TS_Obj (vla-addObject Table_Dict Table_Name "AcDbTableStyle"))
(vla-put-HorzCellMargin TS_Obj 0.05)
(vla-put-VertCellMargin TS_Obj 0.05)
(vla-put-TitleSuppressed TS_Obj :vlax-false)
(vla-put-HeaderSuppressed TS_Obj :vlax-false)
(vla-put-Description TS_Obj (strcat "Table Style = " Table_Name))
(if (and TS_Obj (not (vlax-object-released-p TS_Obj))) (vlax-release-object TS_Obj))
(if (and Table_Dict (not (vlax-object-released-p Table_Dict))) (vlax-release-object Table_Dict))
(if (and Acad_Dict (not (vlax-object-released-p Acad_Dict))) (vlax-release-object Acad_Dict))
(if (and Acad_Obj (not (vlax-object-released-p Acad_Obj))) (vlax-release-object Acad_Obj))
(princ)
)
(setq obj (ssget "_:E:S+." (list (cons 0 "ACAD_TABLE"))))
(setq obj (vlax-ename->vla-object (ssname obj 0)))
(vla-put-FlowDirection obj acBottomToTop)
-
https://forums.augi.com/showthread.php?61105-Inserting-blocks-in-table-cells-using-LISP/page2
(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)
)
(defun C:BDT (/ acmcol acsp adoc axss blkid cnt
col columns desc desc_wid dht headers
i lst_count lst_name objtable row
rows 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 lst_count nil)
(vlax-for a (vla-get-blocks adoc)
(if (and (eq :vlax-false (vla-get-isxref a))
(eq :vlax-false (vla-get-islayout a))
(not (wcmatch (vlax-get a 'Name) "*|*,`**,_*" )))
(setq lst_count (cons (vlax-get a 'Name) 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 (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)))))
(if (zerop desc_wid)
(setq desc_wid (* (getvar "dimtxt")
(strlen "No description for this symbol"))))
(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)
(1+ 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 15))
(vla-setcolumnwidth objtable 2 desc_wid)
(vla-setcolumnwidth objtable 3 (* dht 15))
(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" "BLOCK NAME" "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 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 (length lst_count)))
(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 BDT to execute |>\n"
)
(prompt
"\n\t\t\t |-----------------------------|\n"
)
; TesT : (C:BDT)
-
Thank you, I believe that will give me what I need to get started.