社区 › VB › 这段填充图案的代码错在那里了？

nhy12345678 发表于 2008-5-9 18:38:00

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

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 发表于 2008-5-11 19:54:00

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 发表于 2008-5-14 15:05:00

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

查看完整版本: 这段填充图案的代码错在那里了？