Addhatch有多个AppendInnerLoop

baneit319

Addhatch有多个AppendInnerLoop时运行出错，提示“输入无效” ，请问应如何修改？我试了把下面改成 inloop(0 to 0）只使用一个内部的inloop就可以运行，确认了图形没有错，item(1)和item(2)是在 item(0)的内部，并封闭。
Sub kk()

Dim pname As String
Dim hatchobj As AcadHatch
Dim ba As Boolean
Dim pat As Long
Dim outloop(0 To 0) As AcadEntity
Dim inloop(0 To 1) As AcadEntity
pat = 0
pname = "ANSI31"
ba = True
Set outloop(0) = ThisDrawing.ModelSpace.Item(0)
Set inloop(0) = ThisDrawing.ModelSpace.Item(1)
Set inloop(1) = ThisDrawing.ModelSpace.Item(2)
Set hatchobj = ThisDrawing.ModelSpace.AddHatch(pat, pname, ba)
hatchobj.AppendOuterLoop (outloop)
hatchobj.AppendInnerLoop (inloop)
hatchobj.Evaluate
ThisDrawing.Regen True

End Sub

baneit319

没人会吗？我就想知道，如果有两个inloop时，怎么改？

zzyong00

inloop如果使用多于一个对象，它们的端点必须相接以形成一个环。

zzyong00

Sub Example_AppendInnerLoop()
    ' This example creates an associative hatch in model space.
   
    Dim hatchObj As AcadHatch
    Dim patternName As String
    Dim PatternType As Long
    Dim bAssociativity As Boolean
   
    ' Define the hatch
    patternName = "Solid"
    PatternType = 0
    bAssociativity = True
   
    ' Create the associative Hatch object
    Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
   
    ' Create the outer loop for the hatch.
    ' An arc and a line are used to create a closed loop.
   
    Dim outerLoop(0 To 1) As AcadEntity
    Dim center(0 To 2) As Double
    Dim radius As Double
    Dim startAngle As Double
    Dim endAngle As Double
    center(0) = 5: center(1) = 3: center(2) = 0
    radius = 3
    startAngle = 0
    endAngle = 3.141592
    Set outerLoop(0) = ThisDrawing.ModelSpace.AddArc(center, radius, startAngle, endAngle)
    Set outerLoop(1) = ThisDrawing.ModelSpace.AddLine(outerLoop(0).StartPoint, outerLoop(0).EndPoint)
        
    ' Append the outer loop to the hatch object
    hatchObj.AppendOuterLoop (outerLoop)
   
    ' Append a circle as the inner loop for the hatch.
    Dim innerLoop(1) As AcadEntity
    center(0) = 5: center(1) = 4.5: center(2) = 0
    radius = 1
    Set innerLoop(0) = ThisDrawing.ModelSpace.AddArc(center, radius, startAngle, endAngle)
    Set innerLoop(1) = ThisDrawing.ModelSpace.AddLine(innerLoop(0).StartPoint, innerLoop(0).EndPoint)
    hatchObj.AppendInnerLoop (innerLoop)
   
    ' Evaluate and display the hatch
    hatchObj.Evaluate
    ThisDrawing.Regen True
   
End Sub

baneit319

zzyong00 发表于 2015-6-6 15:48
inloop如果使用多于一个对象，它们的端点必须相接以形成一个环。

如果是分开的两个独立图形怎么办？有没有其他办法？我的图形就相当于一个脸上（圆），有两眼睛（里面两个眼），还有嘴巴（三角形），鼻子（小矩形）等。

zzyong00

baneit319 发表于 2015-6-6 15:53
如果是分开的两个独立图形怎么办？有没有其他办法？我的图形就相当于一个脸上（圆），有两眼睛（里面两个 ...

Option Explicit

Sub Example_AppendInnerLoop()
    ' This example creates an associative hatch in model space.
   
    Dim hatchObj As AcadHatch
    Dim patternName As String
    Dim PatternType As Long
    Dim bAssociativity As Boolean
   
    ' Define the hatch
    patternName = "Solid"
    PatternType = 0
    bAssociativity = True
   
    ' Create the associative Hatch object
    Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
   
    ' Create the outer loop for the hatch.
    ' An arc and a line are used to create a closed loop.
   
    Dim outerLoop(0 To 1) As AcadEntity
    Dim center(0 To 2) As Double
    Dim radius As Double
    Dim startAngle As Double
    Dim endAngle As Double
    center(0) = 5: center(1) = 3: center(2) = 0
    radius = 3
    startAngle = 0
    endAngle = 3.141592
    Set outerLoop(0) = ThisDrawing.ModelSpace.AddArc(center, radius, startAngle, endAngle)
    Set outerLoop(1) = ThisDrawing.ModelSpace.AddLine(outerLoop(0).StartPoint, outerLoop(0).EndPoint)
        
    ' Append the outer loop to the hatch object
    hatchObj.AppendOuterLoop (outerLoop)
   
    ' Append a circle as the inner loop for the hatch.
    Dim innerLoop(1) As AcadEntity
    center(0) = 5: center(1) = 4.5: center(2) = 0
    radius = 1
    Set innerLoop(0) = ThisDrawing.ModelSpace.AddArc(center, radius, startAngle, endAngle)
    Set innerLoop(1) = ThisDrawing.ModelSpace.AddLine(innerLoop(0).StartPoint, innerLoop(0).EndPoint)
    hatchObj.AppendInnerLoop (innerLoop)
   
    Dim innerLoop2(1) As AcadEntity
    center(0) = 3.3: center(1) = 3.3: center(2) = 0
    radius = 1
    Set innerLoop2(0) = ThisDrawing.ModelSpace.AddArc(center, radius, startAngle, endAngle)
    Set innerLoop2(1) = ThisDrawing.ModelSpace.AddLine(innerLoop2(0).StartPoint, innerLoop2(0).EndPoint)
    hatchObj.AppendInnerLoop (innerLoop2)
   
    ' Evaluate and display the hatch
    hatchObj.Evaluate
    ThisDrawing.Regen True
   
End Sub

baneit319

zzyong00 发表于 2015-6-6 16:09
Option Explicit

Sub Example_AppendInnerLoop()

明白了，感谢老大，原来一个inner要appendinnerloop一遍呀。