Author Topic: Creating Table Style in LISP  (Read 137 times)

0 Members and 1 Guest are viewing this topic.

cmwade77

  • Swamp Rat
  • Posts: 1229
Creating Table Style in LISP
« 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.

HOSNEYALAA

  • Newt
  • Posts: 53
Re: Creating Table Style in LISP
« Reply #1 on: September 11, 2020, 03:39:07 PM »
Code: [Select]


;;;;;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)

 


HOSNEYALAA

  • Newt
  • Posts: 53
Re: Creating Table Style in LISP
« Reply #2 on: September 11, 2020, 03:42:09 PM »

https://forums.augi.com/showthread.php?61105-Inserting-blocks-in-table-cells-using-LISP/page2

Code: [Select]


(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)


cmwade77

  • Swamp Rat
  • Posts: 1229
Re: Creating Table Style in LISP
« Reply #3 on: September 11, 2020, 04:49:25 PM »
Thank you, I believe that will give me what I need to get started.