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