- 积分
- 17084
- 明经币
- 个
- 注册时间
- 2003-2-26
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2003-8-25 22:44:00
|
显示全部楼层
参考一下:
Dim entity As Object
Dim found As Boolean
Dim hatchObj As AcadHatch
Dim patternName As String
Dim PatternType As Long
Dim bAssociativity As Boolean
patternName = "SOLID" '填充样式
PatternType = 0
bAssociativity = True
Dim circleobj(0 To 0) As AcadCircle '声明填充边界
Set hatchObj = ThisDrawing.ModelSpace.AddHatch _
(PatternType, patternName, bAssociativity) '创建填充
For Each entity In ThisDrawing.ModelSpace
With entity
If (.EntityName = "AcDbCircle") Then
If (.Radius = 0.4) Then '若圆半径为0.4
Set circleobj(0) = ThisDrawing.ModelSpace.AddCircle(.Center, 1.28) '创建需要填充的边界
hatchObj.AppendOuterLoop (circleobj) '填充
found = True
End If
End If
End With
Set entity = Nothing '清空当前实体
Set circleobj(0) = Nothing '清空边界
Next entity '下一实体
If Not found Then '没有发现符合条件的实体
MsgBox "没有发现需要填充的圆", vbInformation
End If |
|