[求助]怎么用Hatch对凹多边形进行填充?
<p>请问怎么实现凹多边形的填空呢?我用Hatch只能给凸多边形填充。</p><p>我是直接用线段作为外边界调用Hatch可是会报错如下:</p><p>运行时错误“91”</p><p>对象变量或with块变量未设置</p><p>程序如下,这只是一个测试程序,没有实际意义:</p><p>Public Sub TestHatch()<br/>Dim objList(11) As AcadEntity<br/>Dim pt1(0 To 2) As Double<br/>Dim pt2(0 To 2) As Double<br/>Dim pt3(0 To 2) As Double<br/>Dim pt4(0 To 2) As Double<br/>Dim pt5(0 To 2) As Double<br/>Dim pt6(0 To 2) As Double<br/>Dim pt7(0 To 2) As Double<br/>Dim pt8(0 To 2) As Double<br/>Dim pt9(0 To 2) As Double<br/>Dim pt10(0 To 2) As Double<br/>Dim pt11(0 To 2) As Double<br/>Dim pt12(0 To 2) As Double<br/>Dim pt(0 To 2) As Double</p><p>pt1(0) = 160: pt1(1) = 90: pt1(2) = 0<br/>pt2(0) = 200: pt2(1) = 90: pt2(2) = 0<br/>pt3(0) = 200: pt3(1) = 100: pt3(2) = 0<br/>pt4(0) = 190: pt4(1) = 100: pt4(2) = 0<br/>pt5(0) = 190: pt5(1) = 110: pt5(2) = 0<br/>pt6(0) = 200: pt6(1) = 110: pt6(2) = 0<br/>pt7(0) = 200: pt7(1) = 120: pt7(2) = 0<br/>pt8(0) = 165: pt8(1) = 120: pt8(2) = 0<br/>pt9(0) = 160: pt9(1) = 115: pt9(2) = 0<br/>pt10(0) = 170: pt10(1) = 115: pt10(2) = 0<br/>pt11(0) = 170: pt11(1) = 110: pt11(2) = 0<br/>pt12(0) = 160: pt12(1) = 100: pt12(2) = 0<br/>pt(0) = 165: pt(1) = 115: pt(2) = 0</p><p>objList(0) = AddArcRt(pt, 5, 2)<br/>objList(1) = ThisDrawing.ModelSpace.AddLine(pt1, pt2)<br/>objList(2) = ThisDrawing.ModelSpace.AddLine(pt2, pt3)<br/>objList(3) = ThisDrawing.ModelSpace.AddLine(pt3, pt4)<br/>objList(4) = ThisDrawing.ModelSpace.AddLine(pt4, pt5)<br/>objList(5) = ThisDrawing.ModelSpace.AddLine(pt5, pt6)<br/>objList(6) = ThisDrawing.ModelSpace.AddLine(pt6, pt7)<br/>objList(7) = ThisDrawing.ModelSpace.AddLine(pt7, pt8)<br/>objList(8) = ThisDrawing.ModelSpace.AddLine(pt9, pt10)<br/>objList(9) = ThisDrawing.ModelSpace.AddLine(pt10, pt11)<br/>objList(10) = ThisDrawing.ModelSpace.AddLine(pt11, pt12)<br/>objList(11) = ThisDrawing.ModelSpace.AddLine(pt12, pt1)<br/>Dim color As AcadAcCmColor<br/>Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")<br/>Call color.SetRGB(0, 255, 127)<br/>AddHatchTC objList, 0, True, color<br/>End Sub</p> Set objList(0) = AddArcRt(pt, 5, 2)<br/>Set objList(1) = ThisDrawing.ModelSpace.AddLine(pt1, pt2)<br/>Set objList(2) = ThisDrawing.ModelSpace.AddLine(pt2, pt3)<br/>Set objList(3) = ThisDrawing.ModelSpace.AddLine(pt3, pt4)<br/>Set objList(4) = ThisDrawing.ModelSpace.AddLine(pt4, pt5)<br/>Set objList(5) = ThisDrawing.ModelSpace.AddLine(pt5, pt6)<br/>Set objList(6) = ThisDrawing.ModelSpace.AddLine(pt6, pt7)<br/>Set objList(7) = ThisDrawing.ModelSpace.AddLine(pt7, pt8)<br/>Set objList(8) = ThisDrawing.ModelSpace.AddLine(pt9, pt10)<br/>Set objList(9) = ThisDrawing.ModelSpace.AddLine(pt10, pt11)<br/>Set objList(10) = ThisDrawing.ModelSpace.AddLine(pt11, pt12)<br/>Set objList(11) = ThisDrawing.ModelSpace.AddLine(pt12, pt1)<br/> <p>真的是谢谢您啦!自己也是粗心,居然没有加Set就运行呢,还多亏您提醒,谢谢!谢谢<br/>!</p><p>我是第一次接触CAD二次开发,帮老板做一个小小的任务。</p>
页:
[1]