创建和填充AutoCAD表

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
    oSset.SelectOnScreen dxfCode, dxfValue
    Dim oSpace As AcadBlock
    If ThisDrawing.ActiveSpace = acModelSpace Then
        Set oSpace = ThisDrawing.ModelSpace
    Else
        Set oSpace = ThisDrawing.PaperSpace
    End If
    
    varPt = ThisDrawing.Utility.GetPoint(, vbCrLf & "Specify insertion point: ")
    Dim oTable As AcadTable
    Set oTable = oSpace.AddTable(varPt, oSset.Count + 2, 3, 10, 30)
    ZoomExtents
    With oTable
    .RegenerateTableSuppressed = True
        .SetCellTextHeight i, j, 5
        .SetCellAlignment i, j, acMiddleCenter
        .SetCellType i, j, acTextCell
        .SetText 0, 0, "Blocks Position"
        .SetCellType i, j, acTextCell
        
        .SetText 1, j, "Block Name"
        .SetCellTextHeight 1, j, 4.5
        .SetText 1, j + 1, "X"
        .SetCellTextHeight 1, j + 1, 4.5
        .SetText 1, j + 2, "Y"
        .SetCellTextHeight 1, j + 2, 4.5
        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(0), 3)), "#0.000")
            yStr = Format(CStr(Round(oBlk.InsertionPoint(1), 3)), "#0.000")
            .SetCellTextHeight i, j, 4
            .SetCellAlignment i, j, acMiddleCenter
            .SetText i + 2, j, bName
            .SetCellTextHeight i + 2, j, 4#
            .SetText i + 2, j + 1, xStr
            .SetCellTextHeight i + 2, j + 1, 4#
            .SetText i + 2, j + 2, yStr
            .SetCellTextHeight i + 2, j + 2, 4#
        Next i
    .RegenerateTableSuppressed = False
    .Update
    End With
    MsgBox "done"
End Sub