[求助]这样的填充效果如何用VBA实现？

小顽童

8楼的大哥，我把代码帖上来了，添加内边界老是出错，请你指导一下，非常感谢！

 

Sub HH()
'On Error Resume Next
Dim ent As AcadEntity
Dim Pname As String
Dim Ptype As Long
Dim Ba As Boolean
Dim Hatchobj As AcadHatch
Pname = "ANSI33" '填充样式
Ptype = acHatchPatternTypePreDefined '填充类型
Ba = True '是否关联
Dim Outer(0 To 0) As AcadEntity

Dim i As Integer
Dim j As Integer
Dim s As Integer
Dim Plobj As AcadPolyline
Dim coor As Variant
Dim coords As Variant
Dim pnt As Variant
Dim Sset As AcadSelectionSet

 

'clearsset

Set Sset = ThisDrawing.SelectionSets.Add("GD")

ThisDrawing.Utility.GetEntity ent, pnt, "c"

coords = ent.Coordinates

Sset.SelectByPolygon acSelectionSetWindowPolygon, coords

 

Dim K As Integer

ReDim Inner(0 To Sset.Count - 1) As AcadEntity

 
For K = 0 To Sset.Count - 1

    Set Inner(K) = Sset.Item(K)

Next
Sset.Delete
Set Outer(0) = ent '定义填充外边界

Set Hatchobj = ThisDrawing.ModelSpace.AddHatch(Ptype, Pname, Ba)
'Hatchobj.HatchStyle = acHatchStyleOuter
Hatchobj.AppendOuterLoop Outer

Hatchobj.AppendInnerLoop Inner

Hatchobj.Evaluate

ThisDrawing.Regen True

End Sub

雪山飞狐_lzh

像你的例题的图像要调用Hatchobj.AppendInnerLoop 两遍

内外边界的图形要首尾相连且闭合

小顽童

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

liushengk

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

wuyunpeng888

看看这个帖子吧，可能对你会有帮助http://www.boxuesky.com/read-htm-tid-25503.html