Acad TableStyle full method


Acad Tablestyle can be programmed efficiently without duplicating code using a global variable for the Tablestyle object. While it is tempting to re-create the Autocad Tablestyle dialog in a VBA form, it would be difficult to improve on it and it would be a lot of work. The following program is a more or less full implementation of the tablestyle creation in code. Doubtless there could be some improvement of the variable listings, making them easier to create a list of standard tablestyles. This will do for a template in how tablestyles are made. an input form could interface with this style easily.

Option Explicit

Public TS As AcadTableStyle

'tablestyle creation all in code, no form input
'based on the autocad tablestyle dialog
'sub calls are closely related to the tabs General, Text and Borders
'each sub is called 3 times with rowtype, just like the dialog
'purpose would be to create a favorite std style with all variables in code
'but form input would go thru this format also
'to create a 2nd style copy this header sub and modify values

Sub make_table_style_std()
    Call connect_acad
    Call set_text_style 'for now so we have textstyle selection
    Dim col As AcadAcCmColor
    Set col = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.20")
    Dim rowtypes As Long
    Dim tablestylename As String
     'set up vars for general tab
    Dim blncolor As Boolean
    Dim alignment As Integer
    Dim marginhoriz As Double, marginvert As Double
    Dim blnmerge As Boolean
     'set up vars for text tab
    Dim textstyle As String
    Dim textheight As Double
     'set up vars for borders tab
    Dim lineweight As Integer
    tablestylename = "Tb_Style1"
'first call that creates or sets the tablestyle
Call table_style_std(tablestylename)

 'set up vars for general tab
    Call col.SetRGB(0, 0, 0)
    blncolor = False
    alignment = 5 'centered
    marginhoriz = 0.06
    marginvert = 0.06
    blnmerge = False

'call ts_general 3 times once for each row type, chg vars as needed
Call ts_General(acTitleRow, blncolor, col, alignment, marginhoriz, marginvert)

Call ts_General(acHeaderRow, blncolor, col, alignment, marginhoriz, marginvert)
alignment = 6 'right

Call ts_General(acDataRow, blncolor, col, alignment, marginhoriz, marginvert)

Call ts_merge

 'set up vars for text tab
    textstyle = "Tahoma"
    textheight = 0.1875
    Call col.SetRGB(0, 0, 0)
'call ts_text 3 times once for each row type, chg vars as needed
Call ts_Text(acTitleRow, textstyle, textheight, col)
    textheight = 0.125

Call ts_Text(acHeaderRow, textstyle, textheight, col)
    textheight = 0.09375

Call ts_Text(acDataRow, textstyle, textheight, col)

 'set up vars for borders tab
    lineweight = 40
    Call col.SetRGB(0, 0, 255)
 'call ts_border 3 times once for each row type, chg vars as needed
Call ts_Borders(acTitleRow, lineweight, col)

Call ts_Borders(acHeaderRow, lineweight, col)
    lineweight = 30

Call ts_Borders(acDataRow, lineweight, col)
End Sub


Sub table_style_std(stylname As String)
'main entry called first
    Dim dictionaries As AcadDictionaries
    Dim dictObj As AcadDictionary
    Set dictionaries = acadDoc.Database.dictionaries
    Set dictObj = dictionaries.Item("acad_tablestyle")

    Set TS = dictObj.AddObject(stylname, "AcDbTableStyle")
    TS.Name = stylname
    TS.Description = TS.Name & " TableStyle"
   acadDoc.SetVariable ("ctablestyle"), stylname
End Sub

Sub ts_General(rowtypes As Long, blncolor As Boolean, fillcolor As AcadAcCmColor, alignment As Integer, _
               marginhoriz As Double, marginvert As Double)
'skipping format option and type
'merge is handled in its own sub

'seems to be a problem with autodesk help reference
'setbackgroundcolornone true is the only valid input
'that option sets backgroundcolor to none as desired
'which is contrary to activex help

If blncolor Then
TS.SetBackgroundColor rowtypes, fillcolor
TS.SetBackgroundColorNone rowtypes, True
End If

TS.SetAlignment rowtypes, alignment
TS.HorzCellMargin = marginhoriz
TS.VertCellMargin = marginvert

End Sub

Sub ts_merge()
'the enablemergeall statement is functional in styles
'titlesuppressed and headersuppressed are not functional in tablestyle
'although they are documented and do not cause an error - they dont do anything
'whether a created table has a title and header is dictated by table method
    TS.EnableMergeAll "Title", True
    TS.EnableMergeAll "Header", False
    TS.EnableMergeAll "Data", False
'the activex help on enablemergeall seems to indicate 2 integer arguments and a boolean
'whilst the program code example is per above, one string row description and boolean
'which is why i put it in its own sub for clarity
End Sub

Sub ts_Text(rowtypes As Long, textstyle As String, textheight As Double, col As AcadAcCmColor)
 'acDatarow=1 acHeaderrow=4 acTitlerow=2
 TS.SetTextStyle rowtypes, textstyle
 TS.SetTextHeight rowtypes, textheight
 TS.SetColor rowtypes, col
'get functtions are similar
 Debug.Print TS.GetTextStyle(rowtypes)
 Debug.Print TS.GetTextHeight(rowtypes)
 Set col = TS.GetColor(rowtypes)
 Debug.Print col.ColorIndex
 Debug.Print col.ColorMethod
 Debug.Print col.ColorName
End Sub

Sub ts_Borders(rowtypes As Long, lineweight As Integer, col As AcadAcCmColor)
   'to set all rowtypes at once use 7 (1+2+4)
   '63 sets all gridlinetypes eg outside inside etc 1, 2, 4, 8, 16, 32
   'somehow you can set the grid linetype eg dashed but i dont see a method
   TS.SetGridColor 63, rowtypes, col
   TS.SetGridLineWeight 63, rowtypes, lineweight
   TS.SetGridVisibility 63, rowtypes, True
End Sub

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

This site uses Akismet to reduce spam. Learn how your comment data is processed.