- UID
- 295996
- 积分
- 0
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2005-7-19
- 最后登录
- 1970-1-1
|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
一个多边形区域里面有两个孤岛,我用程序生成内边界的时候'hatchObj.Evaluate就出错,麻烦EFAN大哥帮我看看哪里是哪里的问题,谢谢!
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
Debug.Print Sset.Count
'Sset.Delete
Set Outer(0) = ent '定义填充外边界
Set hatchObj = ThisDrawing.ModelSpace.AddHatch(Ptype, Pname, Ba)
'Hatchobj.HatchStyle = acHatchStyleOuter
hatchObj.AppendOuterLoop (Outer)
Dim K As Integer
Dim Inner(0 To 0) As AcadEntity
For K = 0 To Sset.Count - 1
Set Inner(0) = Sset.Item(K)
hatchObj.AppendInnerLoop (Inner)
Next
'hatchObj.Evaluate
Sset.Delete
ThisDrawing.Regen True
End Sub |
|