使用AutoCAD VBA创建带填充图案的矩形时遇‘无效对象数组’错误

错误原因分析 #

你这段代码的问题主要有两个：

• 重复创建多段线对象，且传递给AppendOuterLoop的数组存在语法错误（多余的括号导致数组被错误解析）
• AppendOuterLoop要求传入Acad实体对象的数组，但原代码的写法未正确满足该要求

修正后的代码 #

Option Explicit
'OWS Plan View
Sub DrawRectangleHatch()
    Dim AutocadApp As Object
    Dim AutocadDoc As Object
    Dim RectArray(0 To 9) As Double
    Dim rectangle As Object
    Dim patternName As String
    Dim PatternType As Long
    Dim bAssociativity As Boolean
    Dim hatchObj As Object ' Autodesk.AutoCAD.Interop.Common.AcadHatch
    Dim outerLoop() As Object ' 改为Object类型数组，存储Acad实体
    
    ' 定义填充参数
    patternName = "ANSI31"
    PatternType = 0 ' 预定义图案
    bAssociativity = True

    ' 连接或启动AutoCAD
    On Error Resume Next
    Set AutocadApp = GetObject(, "Autocad.Application")
    On Error GoTo 0

    If AutocadApp Is Nothing Then
        Set AutocadApp = CreateObject("Autocad.Application")
        AutocadApp.Visible = True
    End If

    ' 从Excel读取矩形顶点坐标
    RectArray(0) = ActiveSheet.Range("B22").Value
    RectArray(1) = ActiveSheet.Range("C22").Value
    RectArray(2) = ActiveSheet.Range("B23").Value
    RectArray(3) = ActiveSheet.Range("C23").Value
    RectArray(4) = ActiveSheet.Range("B24").Value
    RectArray(5) = ActiveSheet.Range("C24").Value
    RectArray(6) = ActiveSheet.Range("B25").Value
    RectArray(7) = ActiveSheet.Range("C25").Value
    RectArray(8) = ActiveSheet.Range("B26").Value
    RectArray(9) = ActiveSheet.Range("C26").Value

    ' 获取或新建AutoCAD文档
    On Error Resume Next
    Set AutocadDoc = AutocadApp.ActiveDocument
    On Error GoTo 0

    If AutocadDoc Is Nothing Then
        Set AutocadDoc = AutocadApp.Documents.Add
    End If

    ' 创建矩形多段线（仅创建一次）
    Set rectangle = AutocadDoc.ModelSpace.AddLightWeightPolyline(RectArray)
    rectangle.Closed = True ' 显式设置闭合，确保填充范围正确

    ' 创建填充对象
    Set hatchObj = AutocadDoc.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)

    ' 构造填充外边界数组：复用已创建的多段线
    ReDim outerLoop(0 To 0) As Object
    Set outerLoop(0) = rectangle

    ' 关键：传递数组时不要加括号，否则会导致数组被错误解析
    hatchObj.AppendOuterLoop outerLoop

    ' 生成填充
    hatchObj.Evaluate

    ' 缩放至全图
    AutocadApp.ZoomExtents

    ' 释放对象
    Set rectangle = Nothing
    Set hatchObj = Nothing
    Set AutocadDoc = Nothing
    Set AutocadApp = Nothing
End Sub

关键修改点 #

• 将outerLoop的类型从Variant改为Object数组，明确存储AutoCAD实体对象
• 复用已创建的rectangle对象，不再重复创建多段线，避免冗余和错误
• 调用AppendOuterLoop时去掉数组外的括号：hatchObj.AppendOuterLoop outerLoop（VBA中加括号会把数组强制转换为Variant，导致AutoCAD无法识别为实体数组）
• 显式设置多段线Closed = True，确保填充边界闭合（虽原坐标已重复起点，但显式设置更稳妥）

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