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:acadr14samplecampus.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)

2． 采用AutoCad r14.01版

Autodesk公司在r14版中加入了ActiveX Automation，但尚不完善。在隨后推出的14.01版中，Autodesk公司解決了r14版的不少錯誤，使得應用程序運行更為流暢、穩定。如果要進行AutoCad的ActiveX編程，建議采用VB5.0和AutoCad r14.01。

3． 關于ActiveX的資源

國內有不少介紹ActiveX編程及AutoCad的資料，但迄今還未發現有完整討論AutoCad的ActiveX編程的書籍，目前最容易得到的資料就是Autodesk公司編寫的隨機幫助，其中有一章“ActiveX Automation"，有全部對象的方法、屬性說明。

此處推薦幾個有關網址：

Autodesk公司主頁：www.autodesk.com

CadOnline雜志：www.cadonline.com

一個專門探討AutoCad的ActiveX編程的個人主頁：

http://ourworld.compuserve.com/homepages/tonyt/

另外，Autodesk公司的新聞組也是個很好的資源，我在編程中遇到的許多問題都是在新聞組中得到解決的。

news://autodesk.autocad.customization.vba

以上是我在做項目中得到的一點經驗和感受的總結，希望與大家共享，文中的代碼在VB5.0、AutoCad r14.01中調試通過。由于時間倉促，錯誤和不足再所難免，還望不吝指正。