A Table is an Array

Autocad tables and VBA arrays have the same structure. You can make a sub procedure that takes an array passed as argument that makes an autocad table. The table sub can read the array and determine how many rows and columns it contains. The array is made in any sub specific to the task and separate from making or loading the table. The program flow can make just the data table without Title or Headers and add those later from other data.

The simplest way to make an array is with the array function.

ar_labels = Array(“MKNO”, “QTY”, “LENGTH”, “WIDTH”, “DESC”)
‘ ar_labels is single dimension 0 to cnt – 1

Debug.Print LBound(ar_labels) ‘get 0
Debug.Print UBound(ar_labels) ‘get 4

The autocad method to Addtable requires 5 parameters.

RetVal = object.AddTable(InsertionPoint, NumRows, NumColumns, RowHeight, ColWidth

Rowheight and colwidth is up to you. To keep it simple use what generic table Standard supplies at first. numrows and numcolumns come from looking at the array upper and lower index.

To make a table display a single dimension array in a single row.

Call make_1D_table(ar_labels)

Sub make_1D_table(ar As Variant)
' ar is single dimension 0 to cnt - 1
' tbl is public as AcadTable
' RowHeight and ColWidth are public as double
' location pt0 would be public too as soon as needed

     Dim pt0(0 To 2) As Double '000
     Dim i As Integer, j As Integer
     Dim rowcount As Integer, colcount As Integer
       
    rowcount = 1
    colcount = UBound(ar) - LBound(ar) + 1
  
    'create the table sized for the array
    Set tbl = acadDoc.ModelSpace.AddTable(pt0, rowcount, colcount, RowHeight, ColWidth)
 
      'object.UnmergeCells minRow, maxRow, minCol, maxCol
    tbl.UnmergeCells 0, 0, 0, 0
    tbl.TitleSuppressed = True
     tbl.HeaderSuppressed = True
     
 'right here is where table format has to occur before data is entered

'zero base array fits with autocad zero base table
 For j = 0 To colcount - 1
  If Not IsEmpty(ar(j)) And (ar(j)) <> "" Then
     tbl.SetText 0, j, ar(j)
  End If
 Next j
 
tbl.Update
End Sub


For our main 2 dimensional data table, we do the same thing but get table dims first. One issue that comes up on adding tables is the behavior of title and header rows. Another issue is when text overflows a single line and causes the row width to pop down. It pops down automatically, but not up. The cell width should be set before the data is loaded. This table sub is set up to only make data rows. The way it works though, the table is made with title and header rows, I dont think there is any way to stop that, and then the table object methods are used to modify the table. You might want to make the textsize of the title row the same as data in the table style manager, if you are using the Standard style. Otherwise depending on the data loaded, you may get a top row with a different height.

After we get the table made, in real life we want to have our own tablestyle and probably do some formatting of the text before it is written to screen. I am just showing the data side here.


Public ar_labels As Variant
Public ar_dims As Variant
Public tbl As AcadTable
Public RowHeight As Double
Public ColWidth As Double
Public hexstart As String

Sub make_2D_table(ar As Variant)
'table is two-dimensional and any-base
' ar(rows,columns)
'  tbl is public As AcadTable
'  RowHeight and ColWidth are public as Double
'  pt0 could be public when needed
  
    Dim i As Integer, j As Integer
    Dim rowcount As Integer, colcount As Integer
    Dim rowLbound As Integer, colLbound As Integer
    Dim rowUbound As Integer, colUbound As Integer
     
    Dim pt0(0 To 2) As Double
        
    rowLbound = LBound(ar, 1)
    rowUbound = UBound(ar, 1)
    colLbound = LBound(ar, 2)
    colUbound = UBound(ar, 2)
    rowcount = rowUbound - rowLbound + 1
    colcount = colUbound - colLbound + 1
        
    Set tbl = acadDoc.ModelSpace.AddTable(pt0, rowcount, colcount, RowHeight, ColWidth)
    'the tablestyle does not dictate the use of a title or header
    'at this point the table has a title and header
    'whether they are merged on creation is per style method EnableMergeAll "Title", True
    'if the title row textsize in standard is larger than data textsize
    'the title row cell height may be larger than data rows.
    
   '     data rows only option
     tbl.UnmergeCells 0, 0, 0, 0
     tbl.TitleSuppressed = True
     tbl.HeaderSuppressed = True

 'right here is where table format has to occur before data is entered
 'using the methods of tbl object we could hand off to a sub here
 
       For i = rowLbound To rowUbound
         For j = colLbound To colUbound
             If Not IsEmpty(ar(i, j)) Then
         tbl.SetText i - rowLbound, j - colLbound, ar(i, j)
             End If
         Next j
       Next i
     
 'a sub to add title or header can run next
 'tbl.InsertRows 0, RowHeight, 1
  
    acadApp.Update
End Sub

Here is a sub to make a multiplication table array with 12X12 hard wired in.
You can experiment with different numbers and see if the table sub handles it.
There is no title or header row.


Sub test_mult_tbl()
'only job is to fill array ar_dims global
 Dim rows As Integer, i As Integer
 Dim columns As Integer, j As Integer
 
    rows = 12
    columns = 12
    ReDim ar_dims(1 To rows, 1 To columns)
     
    For i = 1 To rows
       For j = 1 To columns
           ar_dims(i, j) = i * j
       Next j
    Next i
End Sub


Sub test_226()
    Call Connect_Acad
    Call test_mult_tbl
        RowHeight = 0.125
        ColWidth = 0.625
    Call make_2D_table(ar_dims)
End Sub

You can make a font table using ascii codes. Fonts use hex codes which are base 16. A 16X16 table displays 256 characters. After we make the data table we will add a title row and put the name of the font in it.


Sub test_ascii_table()
  ' only job is to make array
  ' 0 to 255 ascii table 16^2
Dim rows As Integer, i As Integer
Dim columns As Integer, j As Integer
     
    rows = 16
    columns = 16
    ReDim ar_dims(1 To rows, 1 To columns)
     
    For i = 1 To rows
        For j = 1 To columns
            'ar_dims(i, j) = CInt(((i - 1) * 16 + (j - 1)))
            ar_dims(i, j) = Chr(((i - 1) * 16 + (j - 1)))
        Next j
    Next i

End Sub

It gets called as before but we are adding a title row after the data is written.
Tablestyles have textstyles, so I am creating a new tablestyle each time using the current font name, and putting that font style name into the tablestyle to be used.


Sub test_228()
Call Connect_Acad

'call style before table call
    Call mk_tbl_styl(acadDoc.GetVariable("textstyle"))

'makes ar_dims
    Call test_ascii_table

    RowHeight = 0.125
    ColWidth = 0.375

    Call make_2D_table(ar_dims)

 'add a title row to top after plain table made
   tbl.InsertRows 0, RowHeight, 1
   tbl.MergeCells 0, 0, 0, tbl.columns - 1
   tbl.TitleSuppressed = False
   tbl.SetText 0, 0, acadDoc.GetVariable("textstyle")
 
End Sub


Unicode is a long extension of ascii. There are many sections. You have to look up the hex code of the section you want to display.


Sub test_unicode()
'only job is to make array of unicode block numbers
'hexstart public string

 Dim numstart As Double
 Dim rows As Integer, i As Integer
 Dim columns As Integer, j As Integer
     
    rows = 16
    columns = 16
    ReDim ar_dims(1 To rows, 1 To columns)
    numstart = HexToDec(hexstart)
 
    For i = 1 To rows
        For j = 1 To columns
            ar_dims(i, j) = DecToHex(numstart + (i - 1) * 16 + (j - 1))
            ar_dims(i, j) = "\U+" & ar_dims(i, j)
        Next j
    Next i
End Sub

Sub test_229()
Call Connect_Acad
Call new_textstyle("Cambria Math", "Cambria Math")

hexstart = "2200"
Call test_unicode
   
   RowHeight = 0.125
   ColWidth = 0.5

Call make_2D_table(ar_dims)
   
   'add title row with caption hexnum and textstyle name
   tbl.InsertRows 0, RowHeight, 1
   tbl.MergeCells 0, 0, 0, tbl.columns - 1
   tbl.TitleSuppressed = False
   tbl.SetText 0, 0, "&H" &  hexstart & " " & acadDoc.GetVariable("textstyle")
 
End Sub


Header rows can be inserted just like Title rows. The header data can come from the Array command. The sub is similar to the 1D sub but even simpler.

Advertisements

Acad TableStyle full method

2016-08-28_1

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
Else
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