这段填充图案的代码错在那里了？

nhy12345678

Sub test()
    Dim hatchObj As AcadHatch
    Dim patternName As String
    Dim PatternType As Long
    Dim bAssociativity As Boolean
    Dim outerLoop(0 To 0) As AcadEntity
    ' 定义图案填充
    patternName = "ANSI31"
    PatternType = 0
    bAssociativity = True

    ' 当前图纸的实体数目
    Dim n As Long
    n = ThisDrawing.ModelSpace.Count
   
    ' 调用BOUNDARY命令获取某一点处的边界
    Dim Pt As Variant
    Pt = ThisDrawing.Utility.GetPoint(, "指定内部点: ")
    ThisDrawing.SendCommand "_-Boundary" & vbCr & Pt(0) & "," & Pt(1) & vbCr & vbCr
   
    ' 如果存在边界，则会生成新的实体
    If ThisDrawing.ModelSpace.Count > n Then
        Set outerLoop(0) = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)
    Else
        MsgBox "未发现有效的边界。"
       
    End If
hatchObj.AppendOuterLoop (outerLoop)'这里  运行时错误‘91’ 对象变量或with块变量未设置
    ' 计算并显示图案填充
    hatchObj.Evaluate
    ThisDrawing.Regen True
End Sub

chtd

Sub test()
    Dim hatchObj As AcadHatch
    Dim patternName As String
    Dim PatternType As Long
    Dim bAssociativity As Boolean
    Dim outerLoop(0) As AcadEntity
    ' 定义图案填充
    patternName = "ANSI31"
    PatternType = 0
    bAssociativity = True
Set hatchObj = ThisDrawing.ModelSpace. _
        AddHatch(PatternType, patternName, bAssociativity)

    ' 当前图纸的实体数目
    Dim n As Long
    n = ThisDrawing.ModelSpace.count
   
    ' 调用BOUNDARY命令获取某一点处的边界
    Dim Pt As Variant
    Pt = ThisDrawing.Utility.GetPoint(, "指定内部点: ")
    ThisDrawing.SendCommand "_-Boundary" & vbCr & Pt(0) & "," & Pt(1) & vbCr & vbCr
   
    ' 如果存在边界，则会生成新的实体
    If ThisDrawing.ModelSpace.count > n Then
        Set outerLoop(0) = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.count - 1)
    Else
        MsgBox "未发现有效的边界。"
       
    End If
hatchObj.AppendOuterLoop outerLoop '这里  运行时错误‘91’ 对象变量或with块变量未设置
    ' 计算并显示图案填充
    hatchObj.Evaluate
    ThisDrawing.Regen True
End Sub

改了几处，程序运行正常。

nhy12345678

非常感谢chtd！我QQ：22742129交个朋友吧！