如何用VBA获取AutoCAD块属性？GetAttributes方法报错求解

错误根源 #

你遍历的acadDoc.Blocks是AutoCAD中的块定义集合（BlockTableRecord），这些是块的模板，本身不包含实际插入到图纸中的属性实例。GetAttributes方法只属于插入到图纸中的块参照（BlockReference），所以直接调用块定义的GetAttributes会报错。

修正后的代码 #

Dim cellValue As String
cellValue = ActiveSheet.Range("B5").Value
cellValue = CStr(cellValue)

Dim acadApp As Object
Set acadApp = GetObject(, "AutoCAD.Application")

' 打开DWG文档
Dim acadDoc As Object
Set acadDoc = acadApp.Documents.Open(cellValue)

Dim minhaColecao As Collection
Set minhaColecao = New Collection

' 遍历模型空间中的所有块参照
Dim blockRef As Object
For Each blockRef In acadDoc.ModelSpace
    ' 检查是否是块参照，且块名称为FL01
    If blockRef.ObjectName = "AcDbBlockReference" Then
        If blockRef.Name = "FL01" Then
            Dim atts() As Variant
            ' 先判断块是否有属性，避免无属性时报错
            If blockRef.HasAttributes Then
                atts = blockRef.GetAttributes
                Dim i As Long
                Dim aux As String
                aux = "" ' 初始化字符串
                For i = LBound(atts) To UBound(atts)
                    Select Case atts(i).TagString
                        Case "TIPO"
                            aux = atts(i).TextString
                        Case "SEQ-1"
                            aux = aux & "-" & atts(i).TextString
                        Case "SEQ-2"
                            aux = aux & "-" & atts(i).TextString
                    End Select
                Next i
                ' 只有拼接后的字符串不为空才添加到集合
                If aux <> "" Then
                    minhaColecao.Add aux
                End If
            End If
        End If
    End If
Next blockRef

' 遍历所有布局中的块参照（如果需要捕捉布局里的块）
Dim layout As Object
For Each layout In acadDoc.Layouts
    For Each blockRef In layout.Block
        If blockRef.ObjectName = "AcDbBlockReference" Then
            If blockRef.Name = "FL01" Then
                If blockRef.HasAttributes Then
                    atts = blockRef.GetAttributes
                    Dim j As Long
                    Dim auxLayout As String
                    auxLayout = ""
                    For j = LBound(atts) To UBound(atts)
                        Select Case atts(j).TagString
                            Case "TIPO"
                                auxLayout = atts(j).TextString
                            Case "SEQ-1"
                                auxLayout = auxLayout & "-" & atts(j).TextString
                            Case "SEQ-2"
                                auxLayout = auxLayout & "-" & atts(j).TextString
                        End Select
                    Next j
                    If auxLayout <> "" Then
                        minhaColecao.Add auxLayout
                    End If
                End If
            End If
        End If
    Next blockRef
Next layout

' 将集合内容写入Excel
Dim rowNum As Long
rowNum = 1 ' 从A1开始
Dim item As Variant
For Each item In minhaColecao
    ActiveSheet.Cells(rowNum, 1).Value = item
    rowNum = rowNum + 1
Next item

' 关闭文档
acadDoc.Close False

关键修改点 #

• 把遍历acadDoc.Blocks改成遍历模型空间（ModelSpace）和各布局的Block集合，这些里面才是实际插入的块参照。
• 增加blockRef.ObjectName = "AcDbBlockReference"判断，确保只处理块参照对象。
• 调用GetAttributes前先检查blockRef.HasAttributes，避免块无属性时引发错误。
• 用Select Case替代多个ElseIf，代码逻辑更清晰。
• 替换Select+Offset的单元格定位方式为直接指定行号，操作更高效稳定。

内容的提问来源于stack exchange，提问作者Loizm