明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2407|回复: 8

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

[复制链接]
发表于 2003-8-25 13:35:00 | 显示全部楼层 |阅读模式
本人用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
发表于 2003-8-25 17:45:00 | 显示全部楼层
运行到哪段出错?
发表于 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’时失败!不知道您自己运行时有无错误?
发表于 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”,而保持别处不变,亦获得通过!
感谢各位的热心指导!!
发表于 2003-8-26 20:28:00 | 显示全部楼层
你的说法也是正确的,但你的程序在以后容易更改和调试,还是需要按照我说的方法进行。
 楼主| 发表于 2003-9-2 16:30:00 | 显示全部楼层
OK!在次感谢!!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-28 14:37 , Processed in 0.195783 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表