乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 119|回复: 9

[转帖]用Visual Basic对AutoCAD进行二次开发

[复制链接]

13

主题

396

帖子

5

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
448
发表于 2004-8-6 13:04:00 | 显示全部楼层 |阅读模式
一、引言
                                                                                                                                           一直是CAD市场中的主流产品。随着AutoCAD的日益普及,在其上进行二次开发的也不断更新。从早期的Auto
                                                                                                                                         Lisp、ADS、 DCL到现在流行的 Object ARX、ActiveX Automation、Visual
                                                                                                                                         Lisp,均可十分方便地对AutoCAD进行二次开发。本文主要讨论关于运用Visual
                                                                                                                                         Basic对AutoCAD基于ActiveX Automation的二次开发技术。选用
                                                                                                                                         ActiveX有两个原因,一是因为Visual
                                                                                                                                         Basic的普及性与易用性,二是采用这种方法进行二次开发可方便地实现与其它图形软件的接口,如与Solid
                                                                                                                                         Works实现实体造型与二维绘图的结合,以及根据用户的特殊需要开发出一定功能的软件。
                                                                                                                                           二、ActiveX Automation技术
                                                                                                                                           AutoCAD中的ActiveX
                                                                                                                                         Automation是微软公司ActiveX规范的具体应用。它通过基于ActiveX的自动化对象,为其他应用程序提供了访问AutoCAD内部功能的方法,是AutoCAD最新的开发接口。在运行时,AutoCAD与其他应用程序之间的关系是服务器与客户的关系,开发人员使用支持ActiveX规范的编程语言(如VB、Dephi等)能通过访问AutoCAD的对象模型,把AutoCAD的强大功能集成到应用程序中.AutoCAD的对象模型是一种树型结构模型,根为"AutoCAD
                                                                                                                                         Application",AutoCAD中的所有对象都是AutoCAD
                                                                                                                                         Application的子对象。图1所示为AutoCAD对象模型的层次结构树,其中父对象与子对象之间的关系并不是对象继承关系,而是包含关系。
                                                                                                                                           图1 AutoCAD中ActiveX对象的总结构图
                                                                                                                                           三、ActiveX Automation的使用方法
                                                                                                                                           1. Application对象
                                                                                                                                           如果在计算机系统上安装了AutoCAD,则Windows会自动将其所有的信息注册到系统注册表里。那么在启动Visual
                                                                                                                                         Basic后,用户可以象调用VB自己的对象一样调用AutoCAD所提供的ActiveX。
                                                                                                                                           在编程、调试或运行时至少应该有一个AutoCAD副本在运行。可以通过以下的代码创建AutoCAD对象。
                                                                                                                                           Dim AcadApp as Object '定义一个对象
                                                                                                                                           On Error Resume Next
                                                                                                                                           Set AcadApp =GetObject(,"AutoCAD.Application")
                                                                                                                                           If Err Then '如果没有一个AutoCAD副本在运行
                                                                                                                                           Err.Clear
                                                                                                                                           Set AcadApp =CreateObject("AutoCAD.Application")
                                                                                                                                           AcadApp.Visable =True '启动一个AutoCAD副本并设为可见
                                                                                                                                           If Err Then
                                                                                                                                           MsgBox Err.Description '如果失败,给出错误提示
                                                                                                                                           Exit Sub
                                                                                                                                           End If
                                                                                                                                           End If
                                                                                                                                           2. Preferences与Document对象
                                                                                                                                           与AutoCAD中的Preferences对话框的作用相同,通过Preferences对象可以读取或设置AutoCAD的一些基本设置。Preferences对象通过Application的Preferences属性返回。
                                                                                                                                           Dim AcadPref as Object
                                                                                                                                           Set AcadPref = AcadApp.Preferences
                                                                                                                                           比如,用户可通过Preferences对象进行如下的设置
                                                                                                                                           AcadPref.Cursorsize =100
                                                                                                                                           AcadPref.DisplayScreenMenu =acTrue
                                                                                                                                           AcadPref.DisplayScrollBars =Check1.Value
                                                                                                                                           Document对象表示AutoCAD中中当前打开的文档,对AutoCAD中的任何其它操作都需用到Document对象,该对象可以通过ActiveDocument属性返回。
                                                                                                                                           Dim AcadDoc as Object
                                                                                                                                           Set AcadDoc = AcadApp.ActiveDocument
                                                                                                                                           AutoDesk公司使用了集合的概念。在Document对象中有14个集合,具体如图1所示。与VB中的集合一样,这些集合都支持Add、Item方法与Count属性。例如Add方法可以向该集合中添加一个对象,Item(X)可以的得到该集合中的第X个对象,Count属性可以得到该集合中的对象的个数。
                                                                                                                                           在一个AutoCAD副本运行时,只能同时打开一个
                                                                                                                                         Document。可以调用Document的New、Save方法以及Saved属性来打开或保存一个AutoCAD文档。
                                                                                                                                           If Not AcadDoc.Saved Then
                                                                                                                                           AcadDoc.Save
                                                                                                                                           Else
                                                                                                                                           Set AcadDoc =AcadDoc.New("acad")
                                                                                                                                           End If
                                                                                                                                           3. 创建、查询与修改AutoCAD图形对象
                                                                                                                                           在创建AutoCAD图形对象之前,首先必须定义并创建ModelSpace与PaperSpace集合对象。这两个对象可通过Document对象的ModelSpace属性与PaperSpace属性返回。
                                                                                                                                           Dim moSpace as Object,paSpace as Object
                                                                                                                                           Set moSpace = AcadDoc.ModelSpace
                                                                                                                                           Set paSpace = AcadDoc.PaperSpace
                                                                                                                                           所有关于图形对象操作的方法与属性都包含在这两个对象中。
                                                                                                                                           创建文本对象:
                                                                                                                                           Dim moSpace as Object
                                                                                                                                           Set moSpace =AcadDoc.ModelSpace
                                                                                                                                           Dim Pnt(0 to 2) as Double '定义一个AutoCAD三维点
                                                                                                                                           Dim TextH as Double '定义字符高度
                                                                                                                                           Dim Textstr as String '定义字符变量
                                                                                                                                           Dim TextObj as Object '定义一个AutoCAD文本对象
                                                                                                                                           Pnt(0) =2nt(1) =4: Pnt(2) =0 '初始化坐标
                                                                                                                                           TextH =1
                                                                                                                                           TexrStr =“This is a test”
                                                                                                                                           Set TextObj=moSpace.AddText(TextStr,Pnt,TextH) '创建文本对象
                                                                                                                                           查询与修改图形对象
                                                                                                                                           有时用户不但要创建图形对象,更多的情况是修改或控制已存在的
                                                                                                                                           对象,这就需要对已创建的对象进行查询,从而得到所要操作的对象。
                                                                                                                                           可以通过属性来得到图形对象的个数。
                                                                                                                                           Dim noMSOBJ as String,noPSOBJ as String
                                                                                                                                           NoMSOBJ=Str(moSpace.Count)
                                                                                                                                           NoPSOBJ=Str(paSpace.Count)
                                                                                                                                           MsgBox "Object:Mspace="& noMSOBJ & "space="& noPSOBJ
                                                                                                                                           用户也可以通过For..Loop语句来遍历所有的图形对象或是通过方法来得到某个具体的对象。
                                                                                                                                           下面的代码说明了如何来修改当前中的对象,如果对象为一直线,则修改其颜色为红色,否则不做任何改动。
                                                                                                                                           Dim ent as object
                                                                                                                                           For each ent in mospace
                                                                                                                                           If ent.entityname= "acdline" then
                                                                                                                                           Ent.color=acred
                                                                                                                                           Ent.update
                                                                                                                                           End If
                                                                                                                                           Next
                                                                                                                                           需要注意:如果对图形对象做了改动,则需要调用 Update方法在AutoCAD窗口中重画该对象。
                                                                                                                                           同样,可以得到Model Space中最后生成的图形对象。
                                                                                                                                           Dim ent as object
                                                                                                                                           Set ent = moSpace.Item(moSpace.Count-1)
                                                                                                                                           4. 非图形对象
                                                                                                                                           除了ModelSpace与PaperSpace集合,Document对象中另外12个集合中的对象都是非图形对象,如Layers集合包含了AutoCAD当前文档中所有的层,而Linetypes和TextStyles则分别为线型对象与字符型对象的集合。
                                                                                                                                           创建层
                                                                                                                                           可以调用Layers集合的Add方法创建层。以下代码创建一个名称为LAYER1,颜色为洋红色的层。
                                                                                                                                           Dim layerobj as object
                                                                                                                                           Set layerobj =acadDoc.Layers.Add("LAYER1")
                                                                                                                                           Layerobj.Colors=acMagenta
                                                                                                                                           视口
                                                                                                                                           以下的代码使用ActiveSpace属性设置一个活动的Space,然后调用Viewports集合的Add方法创建一个名为"NEW_VIEWPORT"的视口。当视口建立后,Split方法可使原视口与新视口呈上下排列,最后,ActiveViewport属性使新视口成为活动视口。
                                                                                                                                           Dim vport as object
                                                                                                                                           AcadDoc.ActiveSpace=acModelSpace
                                                                                                                                           Set vport=AcadDoc.Viewports.Add("NEW_VIEWPORT")
                                                                                                                                           Vport.Split acViewport2Vertical
                                                                                                                                           Set AcadDoc.ActiveViewport=vport  
                                                                                                                                           5. 用户输入
                                                                                                                                           Document对象中还包含有一个很重要的子对象Utility,Utility对象提供了一些其它的实用功能,如用户输入控制(user-input)。user-input方法可以在AutoCAD的命令提示行中提示用户输入,并显示相应的输入数据类型。这种类型的输入对于屏幕坐标系,实体选择,短字符与数字的输入有着极为重要的应用。
                                                                                                                                           以下的代码定义了Utility对象。
                                                                                                                                           Dim AcadUtil as object
                                                                                                                                           Set AcadUtil =AcadDoc.Utility
                                                                                                                                           每个user-input方法都在AutoCAD的命令行里给出了适当的输入提示并返回相应的数据类型。如:GetString返回一个字符串,GetPoint返回一个点(三个双精度数值)。也可以调用InitializeUserInput方法进行更高级的输入设置。
                                                                                                                                           用户可以定义一个变量:NL=Chr(13)+Chr(10),将这个变量用于输入提示的开始处。
                                                                                                                                           四、结束语
                                                                                                                                           AutoCAD 的ActiveX Automation技术的出现,标志着AutoCAD
                                                                                                                                         的二次开发技术取得了历史性转折。首先,它首次完全实现了OLE
                                                                                                                                         Automation,使得其他软件可以方便地访问AutoCAD;其次,AutoCAD
                                                                                                                                         首次实现了面向对象的开发技术,用户可以操纵它提供所有的AutoCAD 对象;最后,基于ActiveX
                                                                                                                                         Automation开发技术的开发工具得到空前的膨胀,已不再局限于C及C++系列语言,用Visual Basic,
                                                                                                                                         Delphi等工具都可以进行开发。ActiveX Automation技术大大地提高了系统开发的效率、健壮性及易维护性。
回复

使用道具 举报

8

主题

46

帖子

6

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
78
发表于 2004-8-8 21:58:00 | 显示全部楼层
好东东!期待楼主继续!
回复

使用道具 举报

0

主题

3

帖子

3

银币

初来乍到

Rank: 1

铜币
3
发表于 2004-8-11 13:35:00 | 显示全部楼层
您能解决实际问题么?
回复

使用道具 举报

20

主题

80

帖子

7

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
160
发表于 2004-8-14 00:12:00 | 显示全部楼层
回复

使用道具 举报

5

主题

10

帖子

2

银币

初来乍到

Rank: 1

铜币
30
发表于 2004-8-14 09:47:00 | 显示全部楼层
说的好,需要下载仔细消化
回复

使用道具 举报

0

主题

1

帖子

1

银币

初来乍到

Rank: 1

铜币
1
发表于 2007-1-5 11:29:00 | 显示全部楼层
请问有事例可以指点以下 么?
回复

使用道具 举报

15

主题

195

帖子

9

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
255
发表于 2007-1-5 22:12:00 | 显示全部楼层
就是太慢了。呵……等半天也打不开CAD。
回复

使用道具 举报

0

主题

1

帖子

1

银币

初来乍到

Rank: 1

铜币
1
发表于 2008-7-1 14:16:00 | 显示全部楼层
有没有Autocad VBA 入门到精通
这本书的电子版本啊
很难下到
回复

使用道具 举报

10

主题

18

帖子

5

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
58
发表于 2008-7-3 16:49:00 | 显示全部楼层
好,我要继续学习
回复

使用道具 举报

1

主题

3

帖子

1

银币

初来乍到

Rank: 1

铜币
7
发表于 2008-7-9 21:32:00 | 显示全部楼层
又是这个...妈啊...我次次问人如何在VB下二次开发,个个都是给这个来.
可惜这个根本不能用的啊..........
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-7-4 09:58 , Processed in 0.595352 second(s), 72 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表