小顽童 发表于 2005-11-22 21:23:00

<P>8楼的大哥，我把代码帖上来了，添加内边界老是出错，请你指导一下，非常感谢！</P>
<P>&nbsp;</P>
<P>Sub HH()<BR>'On Error Resume Next<BR>Dim ent As AcadEntity<BR>Dim Pname As String<BR>Dim Ptype As Long<BR>Dim Ba As Boolean<BR>Dim Hatchobj As AcadHatch<BR>Pname = "ANSI33" '填充样式<BR>Ptype = acHatchPatternTypePreDefined '填充类型<BR>Ba = True '是否关联<BR>Dim Outer(0 To 0) As AcadEntity</P>
<P><BR>Dim i As Integer<BR>Dim j As Integer<BR>Dim s As Integer<BR>Dim Plobj As AcadPolyline<BR>Dim coor As Variant<BR>Dim coords As Variant<BR>Dim pnt As Variant<BR>Dim Sset As AcadSelectionSet</P>
<P>&nbsp;</P>
<P><BR>'clearsset</P>
<P>Set Sset = ThisDrawing.SelectionSets.Add("GD")</P>
<P>ThisDrawing.Utility.GetEntity ent, pnt, "c"</P>
<P>coords = ent.Coordinates</P>
<P><BR>Sset.SelectByPolygon acSelectionSetWindowPolygon, coords</P>
<P>&nbsp;</P>
<P>Dim K As Integer</P>
<P><BR>ReDim Inner(0 To Sset.Count - 1) As AcadEntity</P>
<P><BR>&nbsp;<BR>For K = 0 To Sset.Count - 1</P>
<P><BR>&nbsp;&nbsp;&nbsp; Set Inner(K) = Sset.Item(K)</P>
<P><BR>Next<BR>Sset.Delete<BR>Set Outer(0) = ent '定义填充外边界</P>
<P>Set Hatchobj = ThisDrawing.ModelSpace.AddHatch(Ptype, Pname, Ba)<BR>'Hatchobj.HatchStyle = acHatchStyleOuter<BR>Hatchobj.AppendOuterLoop Outer</P>
<P>Hatchobj.AppendInnerLoop Inner</P>
<P>Hatchobj.Evaluate</P>
<P><BR>ThisDrawing.Regen True</P>
<P><BR>End Sub</P>

雪山飞狐_lzh 发表于 2005-11-22 23:14:00

<P>像你的例题的图像要调用Hatchobj.AppendInnerLoop 两遍</P>
<P>内外边界的图形要首尾相连且闭合</P>

小顽童 发表于 2005-11-23 18:54:00

L大哥，我的图形内外边界都是首尾相连，并且闭合，那我的代码有问题吗？

liushengk 发表于 2009-6-18 20:10:00

<p>生成外面的大面域，以及中间的两个黑色小面域，用大面域布尔运算减去里面两个小面域得到新的面域，用Addhatch填充就可以了。</p>

wuyunpeng888 发表于 2009-6-22 21:56:00

看看这个帖子吧，可能对你会有帮助<a href="http://www.boxuesky.com/read-htm-tid-25503.html">http://www.boxuesky.com/read-htm-tid-25503.html</a>
页: 1 [2]
查看完整版本: [求助]这样的填充效果如何用VBA实现？