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

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有