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

潇湘夜雨 · 发表于 2003-8-25 13:35:00

本人用VB编了个小程序，在 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 · 发表于 2003-8-25 17:45:00

运行到哪段出错？

myfreemind · 发表于 2003-8-25 22:44:00

参考一下:
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

潇湘夜雨 · 发表于 2003-8-26 09:07:00

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

潇湘夜雨 · 发表于 2003-8-26 09:16:00

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

mccad · 发表于 2003-8-26 10:07:00

因为我这里没有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
通过这样，你应该可以顺利完成你的程序。

潇湘夜雨 · 发表于 2003-8-26 12:41:00

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

mccad · 发表于 2003-8-26 20:28:00

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

潇湘夜雨 · 发表于 2003-9-2 16:30:00

OK！在次感谢！！

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

发表回复

精选推荐