- UID
- 256703
- 积分
- 16
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2005-5-10
- 最后登录
- 1970-1-1
|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
请教各位高手
如何在vba中编辑图案填充
我找到答案了
大家一起分享
Sub Example_HatchStyle()
' 这个范例在模型空间中建立一个关联式图案填充
' 接着改变图案填充样式来示范各种
' 内回路的处理方式。
Dim hatchObj As AcadHatch
Dim patternName As String
Dim PatternType As Long
Dim bAssociativity As Boolean
' 定义图案填充
patternName = "ANSI31"
PatternType = 0
bAssociativity = True
' 建立关联的Hatch对象
Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
hatchObj.Update
' 建立图案填充的外回路
' 使用一个弧以及一条线来建立封闭回路
Dim outerLoop(0 To 1) As AcadEntity
Dim center(0 To 2) As Double
Dim radius As Double
Dim startAngle As Double
Dim endAngle As Double
center(0) = 50: center(1) = 30: center(2) = 0
radius = 30
startAngle = 0
endAngle = 3.141592
Set outerLoop(0) = ThisDrawing.ModelSpace.AddArc(center, radius, startAngle, endAngle)
Set outerLoop(1) = ThisDrawing.ModelSpace.AddLine(outerLoop(0).StartPoint, outerLoop(0).EndPoint)
' 附加外回路到图案填充对象
hatchObj.AppendOuterLoop (outerLoop)
Dim innerLoop1(0) As AcadEntity
center(0) = 50: center(1) = 34.5: center(2) = 0
radius = 10
Set innerLoop1(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
hatchObj.AppendInnerLoop (innerLoop1)
' 将图案填充样式设定忽略
hatchObj.HatchStyle = acHatchStyleIgnore
ThisDrawing.Regen True
End Sub |
|