请教各位高手,该程序错在何处?头疼!!
本帖最后由 作者 于 2003-8-25 13:32:42 编辑本人用VB编了个小程序,在AutoCAD R14中创建填充圆,代码如下,为何运行出错?请不吝赐教!
Option Explicit
Private Sub Command1_Click()
Dim AcadApp As AcadApplication
Dim AcadDoc As AcadDocument
Set AcadApp = CreateObject("autocad.application")
AcadApp.Visible = True
Set AcadDoc = AcadApp.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 = AcadDoc.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) = AcadDoc.ModelSpace.AddCircle(center, radius)
hatchObj.AppendOuterLoop (outerLoop)
hatchObj.Evaluate
AcadDoc.Regen True
End Sub 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. youcan 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 Thanks for your help!But the vision I used is R14(CHINESE),when I run your program,it still show that "类型不匹配”!(Set outerloop(0) = ThisDrawing.ModelSpace.AddCircle(center, radius))。What's the wrong?! sorry, i have no idea about that coz i used autocad 2004 to make it.:-)
页:
[1]