|
|
请问怎么实现凹多边形的填空呢？我用Hatch只能给凸多边形填充。
我是直接用线段作为外边界调用Hatch可是会报错如下：
运行时错误“91”
对象变量或with块变量未设置
程序如下，这只是一个测试程序，没有实际意义：
Public Sub TestHatch()
Dim objList(11) As AcadEntity
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double
Dim pt3(0 To 2) As Double
Dim pt4(0 To 2) As Double
Dim pt5(0 To 2) As Double
Dim pt6(0 To 2) As Double
Dim pt7(0 To 2) As Double
Dim pt8(0 To 2) As Double
Dim pt9(0 To 2) As Double
Dim pt10(0 To 2) As Double
Dim pt11(0 To 2) As Double
Dim pt12(0 To 2) As Double
Dim pt(0 To 2) As Double
pt1(0) = 160: pt1(1) = 90: pt1(2) = 0
pt2(0) = 200: pt2(1) = 90: pt2(2) = 0
pt3(0) = 200: pt3(1) = 100: pt3(2) = 0
pt4(0) = 190: pt4(1) = 100: pt4(2) = 0
pt5(0) = 190: pt5(1) = 110: pt5(2) = 0
pt6(0) = 200: pt6(1) = 110: pt6(2) = 0
pt7(0) = 200: pt7(1) = 120: pt7(2) = 0
pt8(0) = 165: pt8(1) = 120: pt8(2) = 0
pt9(0) = 160: pt9(1) = 115: pt9(2) = 0
pt10(0) = 170: pt10(1) = 115: pt10(2) = 0
pt11(0) = 170: pt11(1) = 110: pt11(2) = 0
pt12(0) = 160: pt12(1) = 100: pt12(2) = 0
pt(0) = 165: pt(1) = 115: pt(2) = 0
objList(0) = AddArcRt(pt, 5, 2)
objList(1) = ThisDrawing.ModelSpace.AddLine(pt1, pt2)
objList(2) = ThisDrawing.ModelSpace.AddLine(pt2, pt3)
objList(3) = ThisDrawing.ModelSpace.AddLine(pt3, pt4)
objList(4) = ThisDrawing.ModelSpace.AddLine(pt4, pt5)
objList(5) = ThisDrawing.ModelSpace.AddLine(pt5, pt6)
objList(6) = ThisDrawing.ModelSpace.AddLine(pt6, pt7)
objList(7) = ThisDrawing.ModelSpace.AddLine(pt7, pt8)
objList(8) = ThisDrawing.ModelSpace.AddLine(pt9, pt10)
objList(9) = ThisDrawing.ModelSpace.AddLine(pt10, pt11)
objList(10) = ThisDrawing.ModelSpace.AddLine(pt11, pt12)
objList(11) = ThisDrawing.ModelSpace.AddLine(pt12, pt1)
Dim color As AcadAcCmColor
Set color = AcadApplication.GetInterfaceObject(".AcCmColor.16")
Call color.SetRGB(0, 255, 127)
AddHatchTC objList, 0, True, color
End Sub
|
|
置顶卡
