Message 1 of 7
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
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
Solved! Go to Solution.