[求助]怎么用Hatch对凹多边形进行填充？

enderxu

请问怎么实现凹多边形的填空呢？我用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("AutoCAD.AcCmColor.16")
Call color.SetRGB(0, 255, 127)
AddHatchTC objList, 0, True, color
End Sub

sailorcwx

Set objList(0) = AddArcRt(pt, 5, 2)
Set objList(1) = ThisDrawing.ModelSpace.AddLine(pt1, pt2)
Set objList(2) = ThisDrawing.ModelSpace.AddLine(pt2, pt3)
Set objList(3) = ThisDrawing.ModelSpace.AddLine(pt3, pt4)
Set objList(4) = ThisDrawing.ModelSpace.AddLine(pt4, pt5)
Set objList(5) = ThisDrawing.ModelSpace.AddLine(pt5, pt6)
Set objList(6) = ThisDrawing.ModelSpace.AddLine(pt6, pt7)
Set objList(7) = ThisDrawing.ModelSpace.AddLine(pt7, pt8)
Set objList(8) = ThisDrawing.ModelSpace.AddLine(pt9, pt10)
Set objList(9) = ThisDrawing.ModelSpace.AddLine(pt10, pt11)
Set objList(10) = ThisDrawing.ModelSpace.AddLine(pt11, pt12)
Set objList(11) = ThisDrawing.ModelSpace.AddLine(pt12, pt1)

enderxu

真的是谢谢您啦！自己也是粗心，居然没有加Set就运行呢，还多亏您提醒，谢谢！谢谢
！

我是第一次接触CAD二次开发，帮老板做一个小小的任务。