潇湘夜雨 发表于 2003-8-21 11:22:00

请教各位高手,该程序错在何处?头疼!!

本帖最后由 作者 于 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

蓝色游侠 发表于 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. 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

潇湘夜雨 发表于 2003-8-25 08:43:00

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?!

蓝色游侠 发表于 2003-8-25 18:07:00

sorry, i have no idea about that coz i used autocad 2004 to make it.:-)
页: [1]
查看完整版本: 请教各位高手,该程序错在何处?头疼!!