- 积分
- 615
- 明经币
- 个
- 注册时间
- 2019-3-4
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
完整代码:
Option Explicit
Private Sub Command1_Click()
Dim acadApp As AcadApplication
Set acadApp = GetObject(, "AutoCAD.Application")
Dim hatchObj As AcadHatch
Dim patternName As String
Dim PatternType As Long
Dim bAssociativity As Boolean
'定义填充
PatternType = 0
patternName = "SOLID"
bAssociativity = True '填充图案与边界相关联
'创建填充对象
Set hatchObj = acadApp.ActiveDocument.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
'创建两个同心圆作为填充边界
Dim OuterLoop(0 To 0) As AcadEntity
Dim InnerLoop(0 To 0) As AcadEntity
Dim center(0 To 2) As Double
Dim radius As Double
center(0) = 1: center(1) = 2: center(2) = 0
radius = 20
Set OuterLoop(0) = acadApp.ActiveDocument.ModelSpace.AddCircle(center, radius)
Set InnerLoop(0) = acadApp.ActiveDocument.ModelSpace.AddCircle(center, radius / 2)
'向填充对象添加填充边界
hatchObj.AppendOuterLoop (OuterLoop)
hatchObj.AppendInnerLoop (InnerLoop)
'用Evaluate方法进行求值并显示填充
hatchObj.Evaluate
acadApp.ActiveDocument.Regen True
'输出填充的边界数
Print (hatchObj.NumberOfLoops)
'判断边界的类型
Dim loopNum As Integer
loopNum = hatchObj.NumberOfLoops
Print (loopNum)
Dim num As Integer
num = 0
Dim loopObjs As Variant
Dim hatLoop As Object
'hatLoop = Nothing
Do While num < loopNum
Set hatLoop = hatchObj.GetLoopAt(num, loopObjs)
num = num + 1
If hatLoop.IsPolyline Then
Print (111)
Else
Print (222)
End If
Loop
ZoomExtents
End Sub
其中Set hatLoop = hatchObj.GetLoopAt(num, loopObjs)这句一直报缺少函数或变量的错 不知道为什么
|
|