找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 459|回复: 0

[求助]:EFAN兄,麻烦你帮我看看这个填充问题,谢谢。

[复制链接]
发表于 2005-11-26 12:31:27 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
一个多边形区域里面有两个孤岛,我用程序生成内边界的时候'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
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-9-21 11:02 , Processed in 0.264557 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表