- 积分
- 225
- 明经币
- 个
- 注册时间
- 2003-8-23
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2003-8-23 03:43:00
|
显示全部楼层
hi,there,
i just tested the code you pasted above, it seems like something wrong with the "Acadapplication" coz it is working well when i ticked out this part. you can also get the info about it in help file which is quoted here:
VBA class name:AcadApplication
Create using:
For VB:
GetObject("AutoCAD.Application.16")
CreateObject("AutoCAD.Application.16")
For AutoCAD VBA: ''*******pay attention here!!
Not applicable. The application is always available.
''***********************the working code here,enjoy************
Option Explicit
Sub command1_click()
Dim Acaddoc As AcadDocument
Set Acaddoc = ThisDrawing.Application.ActiveDocument
Dim hatchobj As AcadHatch
Dim patternname As String
Dim patterntype As Long
Dim bassociativity As Boolean
patternname = "ansi31"
patterntype = 0
bassociativity = True
Set hatchobj = ThisDrawing.ModelSpace.AddHatch(patterntype, patternname, bassociativity)
Dim outerloop(0 To 0) As AcadEntity
Dim center(0 To 2) As Double
Dim radius As Double
center(0) = 50: center(1) = 50: center(2) = 0
radius = 10
Set outerloop(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
hatchobj.AppendOuterLoop (outerloop)
hatchobj.Evaluate
ZoomExtents
End Sub |
|