WOOOOOOOOOOOOOO!!!!!!!!!!!!!!!!!!!!HOOOOOOOOOOOOOOO!!!!!!!!!!!!!!!!!!!!!!!!!!
This is the most glorious table I've ever created in Autocad!
Option Explicit
Sub Blocks_Table()
Dim oAtt As AcadAttributeReference
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 vAtts As Variant
Dim I As Long, j As Long
Dim C As Integer
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 + 3, 6, 0.3, 1.5)
oTable.TitleSuppressed = False
oTable.HeaderSuppressed = True
ZoomExtents
With oTable
.RegenerateTableSuppressed = True
.SetCellTextHeight I, j, 0.15625
.SetCellAlignment I, j, acMiddleCenter
.SetCellType I, j, acTextCell
.SetText 0, 0, "EQUIPMENT LAYOUT SCHEDULE"
.SetText 1, 0, "ITEM"
.SetCellTextHeight 1, 0, 0.09375
.SetText 1, 1, "EQUIPMENT DATUM"
.SetCellTextHeight 1, 1, 0.09375
.SetText 1, 4, "DATUM LOCATION"
.SetCellTextHeight 1, 4, 0.09375
.SetText 1, 5, "DESCRIPTION"
.SetCellTextHeight 1, 5, 0.09375
.SetText 2, 1, "N"
.SetCellTextHeight 2, 1, 0.09375
.SetText 2, 2, "E"
.SetCellTextHeight 2, 2, 0.09375
.SetText 2, 3, "EL"
.SetCellTextHeight 2, 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 + 3, j, 0.09375
.SetCellAlignment I + 3, j, acMiddleCenter
.SetText I + 3, j + 1, xStr
.SetCellTextHeight I + 3, j + 1, 0.09375
.SetText I + 3, j + 2, yStr
.SetCellTextHeight I + 3, j + 2, 0.09375
vAtts = oBlk.GetAttributes
For C = 0 To UBound(vAtts)
Set oAtt = vAtts(C)
Select Case oAtt.TagString
Case Is = "ID"
.SetText I + 3, 0, oAtt.TextString
.SetCellTextHeight I + 3, 0, 0.09375
Case Is = "DESC"
.SetText I + 3, 5, oAtt.TextString
.SetCellTextHeight I + 3, 5, 0.09375
Case Is = "ELEVATION"
.SetText I + 3, 3, oAtt.TextString
.SetCellTextHeight I + 3, 3, 0.09375
Case Is = "DATUMLOC"
.SetText I + 3, 4, oAtt.TextString
.SetCellTextHeight I + 3, 4, 0.09375
End Select
Next C
Next I
oTable.MergeCells 1, 2, 0, 0
oTable.MergeCells 1, 2, 4, 4
oTable.MergeCells 1, 2, 5, 5
oTable.MergeCells 1, 1, 1, 3
.RegenerateTableSuppressed = False
.Update
End With
MsgBox "Yahoooooo!"
End Sub
Is the final code.
I will do some tweaking, maybe add some conditional error trapping, or command-line instructions so the user knows what s/he's required to do, but for now I'm the one using it, so this gets me by for now.
The example shown is three tanks... I have NUMEROUS tanks of different types, pumps, ventilators, dust collectors, sumps, and on and on and on...that I need to fill in...
This will most surely be a godsend as we do these... equipment layouts were the biggest thorn to me until now. So menial filling out that schedule by hand!
I thank you (and fixo) so much for this.
I've learned a GREAT deal along the way.... so much... I think my head may explode if I don't call it a day, for now.
Thank you again.