VB 版 (精华区)

发信人: zxfsnow (最近睡眠太少), 信区: VB
标  题: AutoCAD R14与VB 
发信站: 哈工大紫丁香 (2000年06月08日12:16:07 星期四), 转信

发信人: seabird (fish), 信区: VB
标  题: AutoCAD R14与VB
发信站: 碧海青天 (Thu Mar  4 10:13:27 1999), 转信

前言在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可以使用此物件，至此我们已完成了所需的设定（图2）。

建立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仍是值得探究的开发工具。
  
--

 以科计为本,以产业报国!
  超越自我,飞跃无限!
  

※ 来源:·哈工大紫丁香 bbs.hit.edu.cn·[FROM: 202.118.235.249]