本人用VB编了个小程序，在AutoCAD R14中创建填充圆，代码如下，为何运行出错？请不

潇湘夜雨

本人用VB编了个小程序，在AutoCAD R14中创建填充圆，代码如下，为何运行出错？请不吝赐教！[br]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

mccad

运行到哪段出错？

myfreemind

参考一下:

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

潇湘夜雨

二楼的朋友：该程序每次运行至Set outerLoop(0) = AcadDoc.ModelSpace.AddCircle(center, radius) ，提示“类型不匹配！”不知何故？请再诊断一下，多谢！！

潇湘夜雨

三楼的朋友：我运行了一下您的程序，当没有半径0.4的圆时，最后出来对话框“没有发现需要填充的圆”，然后我添加了一半径0.4的圆，再次运行之，提示：“方法‘AddCircle’ 作用于对象‘IAcadModelSpace’时失败！不知道您自己运行时有无错误？

mccad

因为我这里没有R14，你试试是不是这个问题：
你以下的定义是正确的：
Dim outerLoop(0 To 0) As AcadEntity
但它是用来定义填充图案的外环图元，所以把它定义成图元是正确的
但对于生成圆对象来说，把生成的圆对象Set为图元就有问题，你应该把它Set为圆对象，即AcadCircle。
所以你应该再来一句：
Dim circleobj As AcadCircle
然后用
Set circleobj = AcadDoc.ModelSpace.AddCircle(center, radius)
这样应该都可以顺利通过，然后再来一句：
Set outerLoop(0)= circleobj

通过这样，你应该可以顺利完成你的程序。

潇湘夜雨

多谢mccad朋友！真是一语惊醒梦中人！原来就是定义有点问题，我按您的方法改动程序运行之，顺利通过。后来我只将定义Dim outerLoop(0 To 0) As AcadEntity中的“AcadEntity”换成“AcadCircle”或“Object”，而保持别处不变，亦获得通过！
感谢各位的热心指导！！

mccad

你的说法也是正确的，但你的程序在以后容易更改和调试，还是需要按照我说的方法进行。

潇湘夜雨

OK！在次感谢！！