[文章]：转发一篇VBA文章，希望对大家有好处！

bridgewind

AutoCAD R14与VB

--李原宏

　　前言在AutoCAD R14发展工具中，VBA算是最让程式发展人员注目，全新的发展介面加上与Microsoft Office使用相同发展语言，对於我们这些发展人员，可真是一大震撼，不过在高兴之余却听说目前这版
AutoCAD R14只支援VBA而不支援Virtual Basic，需要到R14下一版才支援，实在令人失望。

　　如果您也曾因听说R14不支援Virtual Basic而放弃Virtual Basic，那您可错过一个快速且容易的发展语言，笔者在一次与同事闲聊的偶然机会中意外发现，Virtual Basic可以当做AutoCAD R14的发展工具，笔者虽为C++的忠诚拥护者，见到Virtual Basic也不禁为它喝采，废话不多说，现在就为您说明如何使用Virtual Basic 控制AutoCAD R14。

启始设定

　　在开始说明前请读者先拿出你们的R14光碟，并执行光碟中vbainst\setup.exe程式，安装程式除了安装VBA发展工具外，最重要的是安装了AutoCAD的Object说明书。

　　当您安装完说明书後请执行Virtual Basic，并开始一个空白专案。如图1，在Virutual Basic中选取「专案→设定引用项目→AutoCAD R14Object Library」。在引用项目加入了ACAD Object Library後，就可以在VB用「检视→浏览物件」来查看可使用的AutoCAD物件，若熟悉Virtual Basic应该了解，当物件可以浏览时，也就代表Virtual
Basic可以使用此物件，至此我们已完成了所需的设定。

建立R14物件

　　您可依下面步骤建立R14物件。

　　1.因为ACAD物件在大部分副程式中都会使用到，因此把ACAD object设为全域变数。

Dim acadApp As Object＇建立全域的ACAD object

　　2.可以选择在Load Form或任何其他副程式中建立R14物件，下面范例是在Load Form时建立R14物件，但请特别注意，必须将Visible属性设为TURE，否则将会发觉硬碟拼命转，但萤幕上却没任何变化。

Private Sub Form_Load()
On Error Resume Next
｀如果目前系统中已有执行R14则取得已执行R14物件
Set acadApp = GetObject(， “AutoCAD.Application＂)
If Err Then
Err.Clear
｀如果目前系统尚未有执行R14则建立R14物件(
Set acadApp = CreateObject(“AutoCAD.Application＂)
End If
acadApp.Visible = True ｀请务必将物件Visible属性设为true
End Sub

　　3.您已经可以试著去执行这个程式，建议您，若系统已执行R14，请先结束R14程式，否则无法看到执行结果，因为程式取得物件还未对物件做任何处理，您会发现当执行这个程式则程式会启动R14，从执行的过程您是否体会到Virtual Basic的方便，连程式都不必Complier，甚至不必先存档就可以执行。

　　在R14中画（10,10）至（100,100）的方框

　　当建立acadApp物件後，就可以使用物件所提供的method，下面范例就是利用AddLine method来画出一个四方形，读者可能会对
acadApp.ActiveDocument.ModelSpace.AddLine 这行指令的语法感到困惑，
其实若查看ACAD的Object model（如图3）就可以很清楚了解，addLine是 ModelSpace Entities Collection Object物件的methos，而ModelSpace Entities Collection Object的父物件是 Document Object，Document Object的父物件是Application Object，因此要由acadApp物件来建立Line 物件当然必须透过Document Object与ModelSpace Object；另外值得注意的是，画完line後记得执行acadApp.Update method才能让方框即时显示在萤幕上。

Private Sub DrawBox_Click()
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
Dim p3(0 To 2) As Double
Dim p4(0 To 2) As Double
Dim lineObj As Object
｀设定点座标
p1(0) = 10#
p1(1) = 10#
p1(2) = 0#
p2(0) = 100#
p2(1) = 10#
p2(2) = 0#
p3(0) = 100#
p3(1) = 100#
p3(2) = 0#
p4(0) = 10#
p4(1) = 100#
p4(2) = 0#
｀划第一点到第二点
Set lineObj = acadApp.ActiveDocument.ModelSpace.AddLine(p1, p2)
｀划第二点到第三点
Set lineObj = acadApp.ActiveDocument.ModelSpace.AddLine(p2, p3)
｀划第三点到第四点
Set lineObj = acadApp.ActiveDocument.ModelSpace.AddLine(p3, p4)
｀划第四点到第一点
Set lineObj = acadApp.ActiveDocument.ModelSpace.AddLine(p4, p1)
acadApp.Update
End Sub

　　 读取图档中model space的所有text及mtext文字

　　请读者先看下面范例程式，您是否吓一跳，这绝对是真的，下面这段程式码真的可以读取图档中model space的所有text及mtext文字，acad object将您目前开启的图档中所有绘图物件都放在ActiveDocument中，而ActiveDocument中所有Model space中的物件都放ModelSpace中，因此我们由ActiveDocument.ModelSpace物件的
item method中取出物件，并依物件的EntityType属性来判断是否为文字，及可取出图档中所有文字了。

Private Sub QueryString_Click()
Dim i As Integer
Dim retObj As Object
With acadApp.ActiveDocument.ModelSpace
For i = 0 To .Count - 1 Step 1
Set retObj = .Item(i)
If retObj.EntityType = acText Or retObj.EntityType = acMtext Then
StringList.AddItem retObj.TextString， 0
End If
Next i
End With
StringList.Refresh
End Sub

　　 将图档中所有Line的资料写入资料库

　　想将CAD资料写入Database吗？在Virtual Basic中当然没问题，请先依图4所示在Virutual Basic中选取「专案→设定引用项目→ Microsoft DAO 3.5 Object Library」，以便在Virtual Basic中使用DAO，下面范例将建立test.mdb资料库并将图档中所有Line的资料写入Database中，有关资料库的建立方式您可参考Virtual Basic Online Book的说明，图5为利用Access开起启test.mdb所显示的程式执行结果
。

Private Sub WLineDB_Click()
Dim MyDB As Database， MyWs As Workspace
Dim LineTd As TableDef
Dim LineFlds(7) As Field
Dim filePath As String
Dim rstLine As Recordset
Dim i As Integer
Dim retObj As Object
Dim retPt As Variant

filePath = App.Path + “\test.mdb＂
｀Create workspaces
Set MyWs = DBEngine.Workspaces(0)
｀Create Database
Set MyDB = MyWs.CreateDatabase(filePath, dbLangGeneral, dbVersion30)
｀Create Table
Set LineTd = MyDB.CreateTableDef(“Lines＂)

｀设定栏位资料
Set LineFlds(0) = LineTd.CreateField(“LINE_ID＂, dbLong) ｀使其成为计数资料栏。
LineFlds(0).Attributes = dbAutoIncrField
Set LineFlds(1) = LineTd.CreateField(“LINE_P1X＂, dbDouble)
Set LineFlds(2) = LineTd.CreateField(“LINE_P1Y＂, dbDouble)
Set LineFlds(3) = LineTd.CreateField(“LINE_P1Z＂, dbDouble)
Set LineFlds(4) = LineTd.CreateField(“LINE_P2X＂, dbDouble)
Set LineFlds(5) = LineTd.CreateField(“LINE_P2Y＂, dbDouble)
Set LineFlds(6) = LineTd.CreateField(“LINE_P2Z＂, dbDouble)

｀将栏位加入Table
LineTd.Fields.Append LineFlds(0)
LineTd.Fields.Append LineFlds(1)
LineTd.Fields.Append LineFlds(2)
LineTd.Fields.Append LineFlds(3)
LineTd.Fields.Append LineFlds(4)
LineTd.Fields.Append LineFlds(5)
LineTd.Fields.Append LineFlds(6)
MyDB.TableDefs.Append LineTd

Set rstLine = MyDB.OpenRecordset(“Lines＂)
With acadApp.ActiveDocument.ModelSpace
For i = 0 To .Count - 1 Step 1
Set retObj = .Item(i)
If retObj.EntityType = acLine Then
rstLine.AddNew
retPt = retObj.startPoint
rstLine!LINE_P1X = retPt(0)
rstLine!LINE_P1Y = retPt(1)
rstLine!LINE_P1Z = retPt(2)
retPt = retObj.startPoint
rstLine!LINE_P2X = retPt(0)
rstLine!LINE_P2Y = retPt(1)
rstLine!LINE_P2Z = retPt(2)
rstLine.Update
End If
Next i
End With

rstLine.Close
MyDB.Close

End Sub

　　 将图档中所有Line的资料写入Excel活页簿

Virtual Basic可以控制AutoCAD，当然也可控制Excel或其他Office程式，读者请先依图6所示在Virutual Basic中选取「专案→设定引用项目→Microsoft Excel 5.0 Object Library，在VB中启动Excel的过程与启动AutoCAD物件的方式相同，下面范例将图档中Line的资料写入Excel活页簿中，当然也可以利用Excel来处理运算与分析的功能，以往需要借由ADS或ARX的计算能力才能完成的工作，都可藉由此方式完成
。

Private Sub Export2Excel_Click()
Dim excelApp As Object
Dim cellPos As String
Dim i As Integer
On Error Resume Next
Set excelApp = GetObject(, “Excel.Application＂)
If Err Then
Err.Clear
｀如果目前系统尚未有执行Excel则建立Excel物件(
Set excelApp = CreateObject(“excel.Application＂)
End If
excelApp.Visible = True ｀请务必将物件Visible属性设为true
excelApp.Workbooks.Add
With acadApp.ActiveDocument.ModelSpace
For i = 0 To .Count - 1 Step 1
Set retObj = .Item(i)
If retObj.EntityType = acLine Then
rstLine.AddNew
retPt = retObj.startPoint
cellPos = “A＂ + Trim(str(i + 1))
excelApp.Range(cellPos).Select
excelApp.ActiveCell.FormulaR1C1 = retPt(0)
cellPos = “B＂ + Trim(str(i + 1))
excelApp.Range(cellPos).Select
excelApp.ActiveCell.FormulaR1C1 = retPt(1)
cellPos = “C＂ + Trim(str(i + 1))
excelApp.Range(cellPos).Select
excelApp.ActiveCell.FormulaR1C1 = retPt(2)
retPt = retObj.endPoint
cellPos = “D＂ + Trim(str(i + 1))
excelApp.Range(cellPos).Select
excelApp.ActiveCell.FormulaR1C1 = retPt(0)
cellPos = “E＂ + Trim(str(i + 1))
excelApp.Range(cellPos).Select
excelApp.ActiveCell.FormulaR1C1 = retPt(1)
cellPos = “F＂ + Trim(str(i + 1))
excelApp.Range(cellPos).Select
excelApp.ActiveCell.FormulaR1C1 = retPt(2)
End If
Next i
End With
End Sub

　　 在Virtual Basic中使用OCX

　　读者或许会疑惑，为什麽会有这个主题？虽然Virtual Basic功能强大，但程式开发者应该都了解，新的开发工具最好能使用旧的程式码，否则以往所写的运算式或演算法都需改写的话，就更麻烦且不切实际，利用OCX可将旧c或c++程式改写并提供给Virtual Basic使用。

　　在使用OCX之前必须先将OCX注册，此范例注册方式为Regsvr32 printer.ocx，并请依图7所示在Virutual Basic中选取「专案→设定使用元件」，并点取「printer ActiveX Control modual」，printer
ocx程式请参考程式列表1（编注：此程式因过於庞大，请至CADesigner的Homepage上参看），范例中的OCX中只包含一个 QueryPrinter()的Method，目地为读取系统中Printer清单，下面范例将OCX所取得资料显示在Edit Box 中。

Private Sub ListPrinter_Click()
PrinterListText.Text = PrnOcx.QueryPrinter
PrinterListText.Refresh
End Sub
程式所有使用的元件清单
元件型态 元件名称
Button DrawBox
Button WLineDB
Button Export2Excel
Button ListPrinter
Button QueryString
List Box StringList
Edit Box PrinterListText
OCX PrnOcx

後记

　　看过上面的说明您是否也心动於Virtual Basic强大功能，事实上如果好好利用Virtual Basic可以简易作出以前不易作出的功能，不过如果您非常在乎执行速度，您还是必须使用ARX来开发较为适当，另外Autodesk并未宣布AutoCAD R14支援Virtual Basic，因此若您选择Virtual Basic来开发程式也许会面临未知的问题，虽然如此但Virtual Basic仍是值得探究的开发工具。