I must thank you again fixo, you've been a godsend for this. The last hour I've spent on this was more productive than the 8 hours on and off I spent from the beginning!! (although I'm sure those beginning hours were needed to understand what was going on, this much)
I am having some trouble with my table creation. I'm trying to not have a single-column top row. I wish for it to be un-merged as the rest of the table is. I cannot see or find what it is in the definitions that make the top row into a single cell, rather than a cell for each column.
I can't figure it out. I've only learned how to merge cells using the "object.MergeCells(minRow, maxRow, minCol, maxCol) " method.
Option Explicit
Sub Blocks_Table()
Dim oSset As AcadSelectionSet
Dim oEnt As AcadEntity
Dim oBlk As AcadBlockReference
Dim varPt As Variant
Dim ftype(0) As Integer
Dim fdata(0) As Variant
Dim bName As String
Dim xStr As String
Dim yStr As String
Dim i As Long, j As Long
ftype(0) = 0: fdata(0) = "INSERT"
Dim dxfCode, dxfValue
dxfCode = ftype: dxfValue = fdata
With ThisDrawing.SelectionSets
While .Count > 0
.Item(0).Delete
Wend
Set oSset = .Add("$Blocks$")
End With
ThisDrawing.ActivePViewport.Display True
ThisDrawing.ActiveSpace = acModelSpace
oSset.SelectOnScreen dxfCode, dxfValue
ThisDrawing.ActiveSpace = acPaperSpace
Dim paSpace As AcadPaperSpace
Set paSpace = ThisDrawing.PaperSpace
varPt = ThisDrawing.Utility.GetPoint(, vbCrLf & "Specify insertion point: ")
Dim oTable As AcadTable
Set oTable = paSpace.AddTable(varPt, oSset.Count + 2, 5, 0.3, 1.5)
ZoomExtents
With oTable
.RegenerateTableSuppressed = True
.SetCellTextHeight i, j, 0.09375
.SetCellAlignment i, j, acMiddleCenter
.SetCellType i, j, acTextCell
.SetText 0, j, "ITEM"
.SetCellTextHeight i, j + 2, 0.09375
.SetText 0, j + 2, "EQUIPMENT DATUM"
.SetCellTextHeight i, j + 4, 0.09375
.SetText 0, j + 4, "DATUM LOCATION"
.SetText 1, j + 1, "N"
.SetCellTextHeight 1, j + 1, 0.09375
.SetText 1, j + 2, "E"
.SetCellTextHeight 1, j + 2, 0.09375
.SetText 1, j + 3, "EL"
.SetCellTextHeight 1, j + 3, 0.09375
For i = 0 To oSset.Count - 1
Set oEnt = oSset.Item(i)
Set oBlk = oEnt
If oBlk.IsDynamicBlock Then
bName = oBlk.EffectiveName
Else
bName = oBlk.Name
End If
xStr = Format(CStr(Round(oBlk.InsertionPoint(1), 3)), "#0.000")
yStr = Format(CStr(Round(oBlk.InsertionPoint(0), 3)), "#0.000")
.SetCellTextHeight i, j, 0.09375
.SetCellAlignment i, j, acMiddleCenter
.SetText i + 2, j, "-ID #-"
.SetCellTextHeight i + 2, j, 0.09375
.SetText i + 2, j + 1, xStr
.SetCellTextHeight i + 2, j + 1, 0.09375
.SetText i + 2, j + 2, yStr
.SetCellTextHeight i + 2, j + 2, 0.09375
Next i
.RegenerateTableSuppressed = False
.Update
End With
MsgBox "done"
End Sub
(also, interesting side note... FF3 crashed consistently when trying to paste the code directly from the VBA Manager in acad... I pasted it to notepad, and copied it over here successfully however.)