Table Settings in VLA - How to set a fixed height to table title

Table Settings in VLA - How to set a fixed height to table title

traci_haberghamJQEJT
Enthusiast Enthusiast
762 Views
6 Replies
Message 1 of 7

Table Settings in VLA - How to set a fixed height to table title

traci_haberghamJQEJT
Enthusiast
Enthusiast

Hi there,

I'm trying to fix the height of the table title row in autolisp as this changes depending on the length of the text in the title cell.  I've tried changing all sorts of values and can't find where to fix it!  Any help appreciated.  TIA

 

traci_haberghamJQEJT_0-1733225953497.png

This is how it changes for different areas but the code is exactly the same.

 

My code below (mainly done by the fantastic experts on here)

 

(defun c:ExRoom ( / AH:table_make att atts lst lst2 obj obj2 ss txtsz total val)
 
(defun AH:table_make (numrows numcolumns  txtht /  curspc colwidth numcolumns  objtable rowheight sp doc)
 
 ;; Get the Dictionaries collection and the TableStyle dictionary
 (setq dicts (vla-get-Dictionaries (vla-get-ActiveDocument(vlax-get-acad-object))))
 (setq dictObj (vla-Item dicts "acad_tablestyle"))
 ;(setq tabname (strcat "TXT" (rtos txtsz 2 2)))
 (setq tabname "AREA155")
(vlax-for dname dictobj
 (if (=  (vla-get-name dname) tabname) ; does it exist
 (princ "\nfound")
 (progn
 
;; Create a custom table style
(setq key tabname class "AcDbTableStyle")
(setq custObj (vla-AddObject dictObj key class))
 
;; Set the name and description for the style
(vla-put-Name custObj tabname)
(vla-put-Description custObj tabname)
 
;; Sets the bit flag value for the style
(vla-put-BitFlags custObj 1)
 
;; Sets the direction of the table, top to bottom or bottom to top
(vla-put-FlowDirection custObj acTableTopToBottom)
 
;; Sets the horizontal margin for the table cells
(vlax-put  custObj 'HorzCellMargin txtht)
 
;; Sets the vertical margin for the table cells
(vlax-put custObj 'VertCellMargin txtht)
 
;; Set the alignment for the Data, Header, and Title rows
;(vla-SetAlignment custObj (+ acDataRow acHeaderRow acTitleRow) acMiddleCenter)
(vla-SetAlignment custObj (+ acDataRow) acMiddleLeft)
(vla-SetAlignment custObj (+ acHeaderRow) acMiddleLeft)
(vla-SetAlignment custObj (+ acTitleRow) acMiddleCenter)
 
;; Set the text height for the Title, Header and Data rows
(vla-SetTextHeight custObj acDataRow txtht)
(vla-SetTextHeight custObj acHeaderRow (* txtht 1.5)) ; value changed from 1.2
(vla-SetTextHeight custObj acTitleRow (* txtht 1.5))
  
;; Set the text height and style for the Title row
;(vla-SetTextStyle custObj (+ acDataRow acHeaderRow acTitleRow) "Standard")
(vla-SetTextStyle custObj (+ acDataRow) "PG_Att_150")
(vla-SetTextStyle custObj (+ acHeaderRow) "PG_Att_200")
(vla-SetTextStyle custObj (+ acTitleRow) "PG_Att_250")
  
)
)
)
(setvar 'ctablestyle tabname)
(princ)
)
 
;(setq txtsz (getreal "Enter text size ")) ; OLD CODE
(setq txtsz 155)
;(setq sp (vlax-3d-point (getpoint "Pick top left"))) ; OLD CODE
 
;sets insertion point of table - (3572.45 -19730.2 0.0)
;(setq sp (vlax-3d-point 3572.45 -19730.2 0.0)) - USE THIS CODE WHEN COMPLETE - COORDS OF EX AREA TABLE
(setq sp (vlax-3d-point 22931 -12850 0.0)) ; Table Coordinates
 
(setq doc  (vla-get-activedocument (vlax-get-acad-object) ))
(if (= (vla-get-activespace doc) 0)
  (setq  curspc (vla-get-paperspace doc))
  (setq curspc (vla-get-modelspace doc))
)
 
(setq numrows 3 numcolumns 3)
(setq rowheight txtsz)
(setq colwidth 10)
 
(AH:table_make 3 3 txtsz)
 
(setq objtable (vla-addtable curspc sp numrows numcolumns rowheight colwidth))
(vla-settext objtable 0 0 "                    ")
(vla-settext objtable 1 0 "Existing Room Areas")
(vla-settext objtable 1 1 "Area m²")
(vla-settext objtable 1 2 "Area ft²")
 
(setq obj2 (vlax-ename->vla-object (entlast)))
;(vla-setcolumnwidth obj2 0 (* txtsz 38))
;(vla-setcolumnwidth obj2 1 (* txtsz 12))
;(vla-setcolumnwidth obj2 2 (* txtsz 12))
 
(vla-setcolumnwidth obj2 0 5890)
(vla-setcolumnwidth obj2 1 1860)
(vla-setcolumnwidth obj2 2 1860)
 
(vla-setRowHeight obj2 1 (* txtsz 2.0))
 
 
;*******************************************************************************
;EXISTING DEMISE TABLE
;*******************************************************************************
 
 
;selects existing area blocks
 
  (setq exdemise (ssget "_X" (list '(0 . "INSERT") '(2 . "PG_Ann_Area_Roomtag_Pln_Dyn") '(8 . "PG_Annotation_RoomTag_Existing"))))
  (setq exdemisenum (sslength exdemise))
  (princ (strcat "There are " (rtos exdemisenum) " existing room tags"))(princ)
 
;counts existing area blocks
 
  (setq exdemise (ssget "_X" (list '(0 . "INSERT") '(2 . "PG_Ann_Area_Roomtag_Pln_Dyn") '(8 . "PG_Annotation_RoomTag_Existing"))))
  (setq exdemisenum (sslength exdemise))
  (princ (strcat "There are " (rtos exdemisenum) " existing room tags"))(princ)
 
;adds ex demise area tags to exdemise ss
 
(setq exdemise_sset (ssadd)) 
(sssetfirst nil
   (foreach insert
      (vl-remove-if-not '(lambda (insert) (and (= "PG_Ann_Area_Roomtag_Pln_Dyn" (vla-get-effectivename (vlax-ename->vla-object insert))) 
(vl-some '(lambda (attribute) (and (= "AREATYPE" (vla-get-tagstring attribute))
                                   (= "Ex Room Area" (vla-get-textstring attribute))
                              );closes and
                  )
 
                  (vlax-invoke (vlax-ename->vla-object insert) 'getattributes)
       )))
 
     (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_x" '((0 . "insert") (8 . "PG_Annotation_RoomTag_Existing") (66 . 1))
)))))
 
      (ssadd insert exdemise_sset)
))
 
  (princ (strcat "\n There are " (rtos (sslength exdemise_sset)) " existing room area tags"))(princ)
 
;rename ss
 
(setq ss exdemise_sset)
(princ "\n ex demise selection set renamed")(princ)
 
(setq lst '())
(repeat (setq  x (sslength ss))
 
 (setq lst2 '())
  (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
  (if  (= (vla-get-hasattributes obj) :vlax-true)
   (progn
   (setq atts (vlax-invoke obj "getattributes"))
   (setq lst2 (cons (vla-get-EffectiveName obj) lst2))
   (foreach att atts
    (setq lst2 (cons (vla-get-textstring att) lst2))
   )
   (setq lst (cons (reverse lst2) lst))
   )
   (progn
    (setq lst (cons (list (vla-get-EffectiveName obj)) lst))
   )
  )
)
 
(setq lst (vl-sort lst '(lambda ( a b ) (< (cadr a) (cadr b)))))
(setq tot1 0.0 tot2 0.0)
(foreach val lst
(setq tot1 (+ (atof (nth 4 val)) tot1))
(setq tot2 (+ (atof (nth 5 val)) tot2))
)
 
(setq rownum 2)
(foreach val lst
(vla-InsertRows obj2  rownum  (vla-GetRowHeight obj2 (- rownum 1)) 1)
(vla-settext obj2 rownum  0 (nth 1 val))
(vla-settext obj2 rownum  1 (nth 4 val))
(vla-settext obj2 rownum  2 (nth 5 val))
(setq rownum (1+ rownum))
)
 
(vla-InsertRows obj2  rownum  (vla-GetRowHeight obj2 (- rownum 1)) 1)
(vla-settext obj2 rownum 0 "Totals")
(vla-settext obj2 rownum  1 (strcat (rtos tot1 2 3) " m²"))
(vla-settext obj2 rownum  2 (strcat (rtos tot2 2 3) " ft²"))
(princ)
)
;end of command

 

0 Likes
Accepted solutions (2)
763 Views
6 Replies
Replies (6)
Message 2 of 7

komondormrex
Mentor
Mentor
Accepted solution

hey,

since the title row of a table has index 0, you can set its height generally with 

(vla-setrowheight table_object 0 height_needed)

 

Message 3 of 7

Sea-Haven
Mentor
Mentor
Accepted solution

Maybe this, I have found that making tables need to reset the table vl object using entlast else some things don't reset, not sure why.

 

 

 

I would change this.

 

(vla-settext objtable 0 0 "-")

 

 

 

Try add the reset title row.

 

(vla-setRowHeight obj2 0 (* txtsz 2.0))
(vla-setRowHeight obj2 1 (* txtsz 2.0))

 

 

 

Please let us know.

Message 4 of 7

traci_haberghamJQEJT
Enthusiast
Enthusiast

Thank you, I added the reset title row height and this has made them all consistent now.  THANK YOU 😀

0 Likes
Message 5 of 7

traci_haberghamJQEJT
Enthusiast
Enthusiast

Thank you, yes this was the solution to control the title row height.  They're all consistent now 🙂

0 Likes
Message 6 of 7

Sea-Haven
Mentor
Mentor

Glad it worked I have found little glitches when using tables, doing a reset of the table object using entlast helps.

 

A tip if the table is big suppress its display till you have inserted all rows. It makes a huge difference to speed. You won't see the table being made but it will appear at end in one big flash.

 

(vla-put-regeneratetablesuppressed Objtable :vlax-true) ; speeds up process.
.... code
(vla-put-regeneratetablesuppressed Objtable :vlax-false)

 

Message 7 of 7

traci_haberghamJQEJT
Enthusiast
Enthusiast

Ooh thank you, that sounds great, I'll give that a go 😀

0 Likes