[文章]：应用ActiveX Automation技术进行AutoCad的开发

yttrelq

应用ActiveX Automation技术进行AutoCad的开发


Autodesk公司的AutoCad软件广泛的应用于建筑、机械等设计领域。众所周知，AutoCad是一种极其灵活的应用系统，用户可以通过编程的方式对其进行定制。在以往的AutoCad系统开发中，最常用的是AutoLisp和ADS，但AutoLisp不如编程语言方便，在开发较大项目时力不从心，而ADS虽由功能强大的C语言编制，但较为复杂，不适应当前可视化编程的需要。幸运的是，在最新推出的AutoCad r14版本中，Autodesk公司对AutoCad本身加入了ActiveX自动化服务功能（ActiveX Automation server capabilities）,使得用户可以通过可视化编程工具，如Visual Basic、Delphi等对AutoCad进行系统开发，极大的提高了工作效率。在最近为建筑公司开发的一套建筑施工三维演示系统中，我们采用AutoCad为平台，Visual Basic为编程工具，成功的应用ActiveX对AutoCad进行了二次开发。本文将从编程实践的角度对使用VB对AutoCad控制的技术及遇到的问题进行简要的说明。


一、 AutoCad的对象模型(AutoCad Object Model)


　　如果一个应用程序支持自动化，那么其他应用程序就可以通过其暴露的对象（Object）对其自动操作。在本例中，我们开发的程序为客户机，AutoCad是服务器，应用程序正是通过对AutoCad暴露的各级对象进行操作而控制AutoCad工作的。对象本身包含自己的方法和属性。通过方法可以实现对象的一些操作，而对象状态信息的收集或改变则是通过属性完成。例如，直线是AutoCad中的一个对象，它的属性可以是线形、起始点坐标、所在层等性质，方法则有拷贝、镜像等操作。

　　理解AutoCad的对象模型是对其编程的基础。AutoCad以层次结构组织对象。在顶层是Application对象（即AutoCad 本身），其他对象均为Application对象的子对象。在Application对象下面是Preferences（优先设置）和Document（文档）对象，通过Preferences对象可以对AutoCad Tools>Preferences菜单项中的几乎每一个选项进行访问和修改，以获取或改变AutoCad的优先设置。Document对象是控制AutoCad图形文件的直接对象，它代表某一个装入的CAD图形文件（一般设为当前激活的文件）。Document对象下面有Model Space（模型空间）和Paper Space（图纸空间）对象及Blocks(块)、Layers (层)、Plot（出图）、Selectionsets（选择集）、 views（视图）、 utility（功能）等一系列对象（集合），其含义与AutoCad中相似。Model Space是当前图形文件中图形实体，如直线、圆、多义线等的集合，每个实体即是一个对象，可通过属性和方法改变实体或生成新实体。对非图形实体，如层（layer）、线形（line type）等的访问则通过访问Document对象下面的相应的集合类型的子对象，如Layers 、LineTypes等来实现。集合类型的对象可以使用VB中所有的集合操作方法。Plot对象提供了访问Plot对话框中各选项的桥梁，使应用程序具有用不同方式控制AutoCad出图的能力。Utility对象使用户在AutoCad命令行与CAD交互成为可能，通过它可以处理整型、浮点型、字符型等用户输入，还可以接受点（Point）或角（Angle）等AutoCad的特殊量。


二、 AutoCad对象的使用


　　在本节中，将结合我做项目得到的一些经验以例程的方式对AutoCad的常用对象及其使用进行讨论。

　　1．开始一个应用程序

　　如前所述，Application对象位于AutoCad层次对象结构的顶层，它代表AutoCad本身，用户的应用程序也理所当然从Appliction对象的建立开始。

Dim acadapp As Object　　　'建立Application对象

Dim acaddoc As Object　　　'建立Document对象

Dim mospace As Object　　　'建立Model Space 对象

On Error Resume Next

Set acadapp = GetObject(, "autocad.application")　 ‘若AutoCad　　　　　　　

　　　　　　　　　　　　　　　　　已启动,则直接得到　　

If Err Then

　Err.Clear

　Set acadapp = CreateObject("autocad.application")　 ‘若

　　　　　　　　　　　 AutoCad未启动，则运行它

　If Err Then

　　MsgBox Err.Description

　　Exit Sub

　End If

End If

acadapp.Visible = True　‘使AutoCad可见

Set acaddoc = acadapp.ActiveDocument　 ‘设acaddoc为当前

　　　　　　　　　　　　　　 图形文件

Set mospace = acaddoc.ModelSpace　‘设mospace为当前图形

　　　　　　　　　　　　　　　　　文件的模型空间

　

以上程序段是应用程序初始化的过程，一般对AutoCad图形文件的操作，主要是与Application、Document和Model Space等对象发生关系。

　 Application对象是一系列对象的父对象，可以通过它的属性设置来改变AutoCad的窗口设置。请看下面代码：

　 acadapp.Top=100　　 '设置AutoCad窗口的位置

　 acadapp.Left=200

　 acadapp.Height=1000　　'调整AutoCad窗口的大小

　 acadapp.Width=800

　 acadapp.Caption="my first application"　 '设置AutoCad窗口的　

　　　　　　　　　　　　　　　　　　　 标题

　 通过Application对象的方法还可以方便的调入ADS或ARX程序，以利于各类程序的集成。其例程为：

Dim arxname As string

acadapp.LoadARX arxname　‘arxname即为调入的arx程序名（带　　路径）

2．通过Document对象对图形文件的操作

Document对象提供了大多数AutoCad的文件功能，可以通过它实现对文件的更新（New）、打开(Open)、输出(Export)、输入(Import)等操作,一般要先把Document对象设为Application对象的 ActiveDocument属性，以返回当前图形文件。

Set acaddoc=Application.ActiveDocument


请看下面的例子对文件的操作：

Dim dwgname As String

dwgname = "c:\acadr14\sample\campus.dwg"

If Dir(dwgname) <> "" Then

　　acaddoc.Open dwgname　　　'打开一个CAD文件

Else

　　acaddoc.new("acad")　　'以acad.dwt为模板建立一个新

　　　　　　　　　　　　　文件

End If

Document对象还提供了两个十分有用的方法——SetVariable 和 GetVariable，通过它们可以得到或改变AutoCad的系统变量。

如：acaddoc.SetVariable "Orthomode", 1　'打开正交模式

dim cadver As String

cadver=acaddoc.Getvariable("Acadver")　 '获取AutoCad的版本号


3．对图形实体的自动操作（生成、编辑、查询）

　 图形实体指所有画在屏幕上的物体，如直线（Line）、圆(Circle)、弧(Arc)、多义线(PolyLine)、文字(Text)等，它们包含于ModelSpace和PaperSpace集合对象中，对实体的操作总要从这两个集合开始，向下查找相应实体的方法或属性。ModelSpace与PaperSpace的含义和AutoCad中类似，它们是所有图形实体的集合，要取得图中的某一实体，一般采用遍历或用实体句柄（Handle）查找的方法。用户可以操作AutoCad自动生成、编辑实体或查询实体参数。请看下例：

　　①生成一个轻量多义线（LightWeight PolyLine）

Dim lwpoly As Object

Dim ptarray(0 To 5) As Double　'设坐标变量

ptarray(0) = 2　　

ptarray(1) = 4

ptarray(2) = 4　　

ptarray(3) = 2

ptarray(4) = 10　

ptarray(5) = 4　　　

Set lwpolyObj = moSpace.AddLightWeightPolyline(ptarray)

‘画多义线（以（2,4,4）(2,10,4)为端点）

②改变一个现有长方体的颜色（假设此实体句柄为"4C"）

　Dim tobj As object

　　　　　　 Set tobj=acaddoc.HandletoObject("4C") '通过Handle来获取

　　　　　　　　　　　　　　　　　　　　　　　　 实体

　tobj.Color=acRed　　 ‘变颜色为红色

　　　　　　 tobj.Update　　　　　 ‘更新状态

③查询当前图形文件中所有实体的实体名、实体句柄、颜色、所在层、线形等参数

Dim ent As Object　　　　　　　　　

Dim msgStr, NL As String　　　　　　　

Dim I as Integer

NL = Chr(13) & Chr(10)　　‘回车与换行

I=1

For Each ent in mospace　'采用迭代遍历模型空间中的实体

　msgStr = "第" & Format(I) & "个实体信息" & NL & NL

　msgStr = msgStr & "实体名: " & ent.EntityName & NL

　msgStr = msgStr & "所在层: " & ent.Layer & NL

　msgStr = msgStr & "颜色: " & Str(ent.Color) & NL

　msgStr = msgStr & "线形: " & ent.Linetype & NL

　msgStr = msgStr & "句柄: " & ent.Handle & NL

　MsgBox msgStr

　I=I+1

Next


4．与用户交互


　 Utility对象提供了与用户在命令行交互的途径，可以让用户输入数字、字符串及角度、点坐标等参量。下面说明如何应用Utility交互替代AutoCad命令中的提示：


Dim acadUtil as Object

Dim stPnt, enPnt As Variant　　　　

Dim prompt1, prompt2 As String　　

Set acadUtil=acaddoc.Utility　　 '设置Utility对象

prompt1 = "起始点： "　‘代替From Point

prompt2 = "终止点： "　 '代替End Point

stPnt = acadUtil.GetPoint(, prompt1)

enPnt = acadUtil.GetPoint(stPnt, prompt2)　'获得用户输入（既可输入坐标值，也可直接在屏幕上选点）

Dim startPoint(0 To 2) As Double　

Dim endPoint(0 To 2) As Double　　

startPoint(0) = stPnt(0)　　　　　　

startPoint(1) = stPnt(1)　　　　　　

startPoint(2) = stPnt(2)　　　　

endPoint(0) = enPnt(0)　　　　

endPoint(1) = enPnt(1)　　　　

endPoint(2) = enPnt(2)　　　

moSpace.AddLine startPoint, endPoint '利用用户输入生成直线

把系统变量设置SetVariable与Utility对象的GetString方法结合，即可向AutoCad的状态行写入内容：

　 Dim yourname as String

　　　　　yourname = acadUtil.GetString(0, " 请输入您的姓名： ")

　 acaddoc.SetVariable "MODEMACRO", yourname & ", 你好！"


5.对非图形对象的操作


　　非图形对象如层（Layers）、视图（Viewports）、坐标系(UCSs)、块　(Blocks)等与图形实体集合ModelSpace、PaperSpace同是Document对象的子对象，它们本身既是对象，又是对象的集合，如Layers是当前打开的图中所有层的集合，使用Add方法来建立新层，并可以遍历所有层，通过改变其属性达到关闭（Off）、冻结层(Freeze)的目的.

①把层名为"wall"的层冻结，打开层名为"beam"的层,并设为当前层

　Dim tlayer as Object

　For Each tlayer In acaddoc.Layers

　　　If tlayer.Name = "wall" Then

　　　　tlayer.Freeze = acTrue　

　　　Else If tlayer.Name="beam" Then

　　　　tlayer.LayerOn = acTrue　

　　　　Set acaddoc.ActiveLayer = tlayer　

　　　End If

　Next

②创建名为"myview"的新视图

可以通过ActiveX自动实现变换视图角度及缩放全图。

Public Sub changeview(ByVal x, ByVal y, ByVal z)

Dim newDirection(0 To 2) As Double

Dim vport As Object

acaddoc.ActiveSpace = acModelSpace ‘使ModelSpace成为活动

　　　　　　　　　　　　　　　　　　 空间

Set vport = acaddoc.Viewports.Add("newview") ‘建立新视图

newDirection(0) = x

newDirection(1) = y

newDirection(2) = z　‘视图的视角方向

vport.Direction = newDirection

acaddoc.ActiveViewport = vport　‘把新视图激活

acaddoc.ActiveViewport.ZoomAll　‘全图显示

End Sub

以上例程是对Layers、Viewports对象的举例，其他非图形对象的引用与此类似。


6．对选择集的操作


　　在对AutoCad的编程中，选择集占有十分重要的地位，对编程者而言，并不清楚图中包含什么实体，只有通过用户的选择或通过过滤条件把所需的实体加入选择集，再对选择集中的实体进行操作。下面例程给出了两种筛选建立选择集的方法，把图中所有在层"wall"上的直线亮显。


①由用户在屏幕上选择实体


　Dim tempset as Object

　Dim obj as Object

　Set tempset = acaddoc.SelectionSets.Add("newset") '建立新选择集

tempset.SelectOnScreen　　 ‘用户在屏幕上选择

　For Each obj In tempset　 ‘遍历选择集中的实体

　　 If obj.EntityName="AcDbLine"　And obj.Layer="wall" Then

　　　　obj.HighLight(True)　'亮显实体

　　 End IF

　Next

　这种选择方式给用户较大的自由，但不能保证选择集内包含所有我们期望的实体，若要精确过滤出所需实体，应该给选择集加入条件。


②使用过滤器（Filter）筛选实体


Dim actualCode(3) As String

Dim actualValue(3) As String

Dim groupcode As Variant

Dim groupValue As Variant

Dim extminpt(2) As Double

Dim extmaxpt(2) As Double

Dim tsset As Object

Dim tobj As Object

actualCode(0) = -4

actualValue(0) = " actualCode(1) = 8　　　　　'保证 Layer是"wall"

actualValue(1) = "wall"

actualCode(2) = 100

actualValue(2) = "AcDbLine"　'所选实体为直线

actualCode(3) = -4

actualValue(3) = "AND>"

extminpt(0) = 0

extminpt(1) = 0

extminpt(2) = 0

extmaxpt(0) = 800

extmaxpt(1) = 400

extmaxpt(2) = 0　　 ‘设选择集涉及区域的左上点与右下点坐标

groupcode = actualCode

groupValue = actualValue

Set tsset = acaddoc.SelectionSets.Add("SS2")

tsset.Select acSelectionSetAll, extminpt, extmaxpt, groupcode,_　 groupValue ‘加了过滤器的选择集　

For Each tobj In tsset

　 tobj.HighLight(True)　 'tobj一定满足既是直线，又在层"wall"上

Nexe

上述变量中groupcode是组码，groupValue是组码下的值。只要找出相应的组码及其下的值，配合条件（And Or Not等，组码为-4）的使用，便可以构造出任意的过滤器，迅速获取所需实体的集合。


7．SendKeys的妙用


　　AutoCad的ActiveX虽然强大，但不是所有问题都可以通过它解决。要在VB中使用AutoCad对象没有的方法，就须用到VB中的过程SendKeys。通过SendKeys把AutoCad的命令行如同批处理一样送到AutoCad中自动执行，在效果上与使用对象的方法是相同的。另外，还可以使用简单的AutoLisp语言增强AutoCad命令行的功能。下例是执行break命令而编写的过程。其中的(handent"***")是从Lisp语言中借来的，可以直接在命令行通过实体句柄（Handle）来确定实体。

　SendKeys "{esc}", True

　SendKeys "{esc}", True　‘避免以前命令的干扰

　SendKeys "_break" & "{enter}", True　

　SendKeys "{(}" & "handent" & """" & wallhandle & """" & "{)}" & "{enter}", True ‘选择要断开的实体（wallhandle为其句柄）

　SendKeys Format(cood1(0)) & "," & Format(cood1(1)) & "{enter}", True

　SendKeys Format(cood2(0)) & "," & Format(cood2(1)) & "{enter}", True　‘cood1与cood2是实体上断开点的坐标


三、 最终的补充说明


1． 尽量采用迭代的方法遍历集合

　　如前所述，对CAD的编程中涉及大量的集合操作，下面的代码段与迭代法效果相同，但效率较低。

　　Dim I As Integer

　　For I=0 To sset.Count-1　　

　　　 sset(I).HighLight(True)

　　Next I

　 在创建自己的集合时，关键字尽量采用Handle值，以便查找，并可通过HandletoObject方法将Handle值转化为实体(Object)

ntchjie

好东西，要打印下来保存。谢谢楼主。

lh163

好

oyxx_1023

刚好在找一些入门级的资料。谢谢楼主。

wlzhzj

好文章！谢谢楼主。

god

请问迭代方法是怎样的，有例子吗？



三、 最终的补充说明


1． 尽量采用迭代的方法遍历集合

　　如前所述，对CAD的编程中涉及大量的集合操作，下面的代码段与迭代法效果相同，但效率较低。

　　Dim I As Integer

　　For I=0 To sset.Count-1　　

　　　 sset(I).HighLight(True)

　　Next I

mkhsj927

[QUOTE]最初由 god 发布
[B]请问迭代方法是怎样的，有例子吗？

我想是不是用 For Each 循环代替 For 循环吧

tfod2000

谢谢搂主，这东西太好了。我正急需呢。太感谢了

齿轮设计

有水平，讲得很通俗易懂。我对对象一直没明白，好象OBJECT也不能代表几个对象啊，点对象，实体对象图层对象等好象都不能用OBJECT来存储的。对象分类好难记

macula55

不错，在那本书上见过。

一生有你

真的不错

min_zxm

好长啊,看来是高手哦