5、VB 代码到 VBA 代码的转换
在 VBA 的 IDE 环境中，使用“导入文件”将要转换的 VB 工程的模块、类模块以及窗体文件一一导入。接着将 VB 代码中所有的当前的文档 (acadDoc) 变量替换为 ThisDrawing，而AutoCAD 应用程序 (acadApp) 变量替换为 Application。同时删除定义的 AutoCAD 应用程序 (acadApp) 和当前的文档 (acadDoc) 变量，删除与 AutoCAD 应用程序连接的代码。注意：要转换 VB 代码的窗体部分，则窗体必须是用 UserForm 创建的。

6、图形对象和非图形对象
图形对象（也称为图元、实体对象）是组成图形的可见对象（例如直线、圆、光栅图像等）。非图形对象是指属于图形的一部分但不可见的（提示性的）对象，例如 Layers、 Linetypes、 DimStyles、 SelectionSets 等等。要创建这些对象，可使用 Add 方法。每一个对象都有用于特定目的的方法和特性，都有设置和检索扩展数据以及删除自己的方法。

7、创建图形对象
图形对象是在 ModelSpace 集合、 PaperSpace 集合或 Block 对象中创建的。
使用变量 moSpace 设置为当前模型空间。
本例使用 AddLightweightPolyline 方法创建一条分为两段的简单多段线，其端点坐标值分别是 (2,4)、(4,2) 和 (6,4)。
Dim moSpace As AcadModelSpace
Set moSpace = acadDoc.ModelSpace
Sub AddLightWeightPolyline()
Dim plineObj As AcadLWPolyline
Dim points(0 To 5) As Double

定义二维多段线的点
points(0) = 2: points(1) = 4
points(2) = 4: points(3) = 2
points(4) = 6: points(5) = 4

在模型空间中创建一个优化多段线对象
Set plineObj = moSpace.AddLightWeightPolyline(points)
End Sub

8、变体型变量（Variant）和数组
变体型变量是一种特殊的数据类型，可以包含任何类型的数据，固定长度的字符串数据和用户定义的类型除外。变量还可以包含特殊值 Empty、Error、Nothing 和 NULL。可以使用 VarType 或 TypeName 函数来确定如何处理变量中的数据。
变体型变量用于和 AutoCAD 传递数组数据。这表示使用对象的属性和方法时，如果输入数组作为参数，那么 VBA 自动将数组转换为变体型变量。此外，从函数或者对象的属性返回的数组数据也将自动转换为变体型变量进行处理。
对第七个问题进行分析：points数组作为参数时，将自动转换成变体型变量，然后才进行生成多段线的操作。同时，如果返回点坐标的数组时，必须先定义一个变体型变量。
示例：
Dim moSpace As AcadModelSpace
Set moSpace = acadDoc.ModelSpace
Sub AddLightWeightPolyline()
Dim plineObj As AcadLWPolyline
Dim points(0 To 5) As Double

定义二维多段线的点
points(0) = 2: points(1) = 4
points(2) = 4: points(3) = 2
points(4) = 6: points(5) = 4

在模型空间中创建一个优化多段线对象
Set plineObj = moSpace.AddLightWeightPolyline(points)

‘ 等效于
‘Dim vpoints As Variant
‘Vpoints=points
‘Set plineObj = moSpace.AddLightWeightPolyline(vpoints)

‘ 返回多段线的从标数组
‘Dim vpoints As Variant
‘vpoints = plineObj.Coordinates

‘ 比较 vpoints 和 points，它们的维数相同，元素个数相同，值也相同。
End Sub

9、系统变量
Document 对象提供了 SetVariable 和 GetVariable 方法，分别用于设置和检索 AutoCAD 系统变量。例如，要将某个整数指定给 MAXSORT 系统变量，可设置为：acadDoc.SetVariable "MAXSORT", 100。
针对第七个问题，如果想让多段线的起点从上一次绘图的终点开始。那么可以检索 LASTPOINT系统变量。
示例：
Dim moSpace As AcadModelSpace
Set moSpace = acadDoc.ModelSpace
Sub AddLightWeightPolyline()
Dim plineObj As AcadLWPolyline

‘ 返回上一次给图最后输入的点坐标
Dim pt as Variant
Pt=acadDoc.GetVariable(“LASTPOINT”)

Dim points(0 To 5) As Double

定义二维多段线的点
points(0) = pt(0): points(1) = pt(1)
points(2) = 4: points(3) = 2
points(4) = 6: points(5) = 4

在模型空间中创建一个优化多段线对象
Set plineObj = moSpace.AddLightWeightPolyline(points)
End Sub
10、图形数据和属性数据
图形对象（也称为图元）是组成图形的可见对象（例如直线、圆、光栅图像等）。属性数据是保存图形对象的信息，比如圆可以代表电杆，那么圆就要保存电杆的信息如类型、地址、高度等。

11、随图形一起保存于文件的内部属性数据和保存于数据库的外部属性数据
属性数据可以保存于文件内部，比如扩展数据和扩展记录数据，它是随图形对象一起保存的，删除图形对象，将自动清除属性数据，因而管理方便。属性数据也可以保存于外部数据库，常见的有文件，如文本文件、Excel文件等，还有数据库，如Access、Oracle等，它需要人工手动进行管理，但数据的存取高效，通常是通过句柄来实现它们之间的联结。

12、图形对象的句柄和ID号
图形对象的句柄在一个文档内是唯一的、递增的、永久的，保存于图形数据库，而图形对象的ID号在当前打开的应用程序的多文档内是唯一的，但是是暂时的、变化的，它不保存于图形数据库，而是每次打开时重新生成一次，因而每次打开时的值也是不一样的。
对于单文档的操作，可以使用Handle来返回图形对象的句柄，而用HandleToObject来获取图形对象。而对于多文档的操作，可以使用ObjectID来返回图形对象的ID号，而用ObjectIDToObject来获取图形对象。

13、扩展数据和扩展记录数据
可以将扩展数据（XData）和扩展记录数据（XRecordData）用作链接信息与图形中对象的方式。扩展数据和扩展记录数据的区别是：扩展数据有16K存储空间的限制，并且使用1000及以上的组码值，而扩展记录数据则没有空间和顺序的限制，并且组码在1000以下。还有一个不同之处是可以在选择集中操作扩展数据。ACAD提供了SetXData和GetXData的函数来设置和返回扩展数据，通常扩展数据需要提供一个已经注册的应用程序（RegisteredApplication）名称作为不同程序之间的数据区分。ACAD也提供了SetXRecordData和GetXRecordData的函数来设置和返回扩展记录数据，但是由于扩展记录数据是保存于扩展词典（ExtensionDictionary）中的，因而要用HasExtensionDictionary来判断是否包含扩展词典，而用GetExtensionDictionary来返回扩展词典，如不存在，它就会创建一个。再通过扩展词典的GetObject来返回扩展记录对象，AddXRecord添加一个扩展记录对象。

示例：
Sub Example_XData()
这个例子创建一条直线，并且添加扩展数据
创建直线
Dim lineObj As AcadLine
Dim startPt(0 To 2) As Double, endPt(0 To 2) As Double
startPt(0) = 1#: startPt(1) = 1#: startPt(2) = 0#
endPt(0) = 5#: endPt(1) = 5#: endPt(2) = 0#
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)
初始化所有的扩展数据。注意第一个值必须是应用程序名称，而它的组码必须是1001。
Dim DataType(0 To 9) As Integer
Dim Data(0 To 9) As Variant
Dim reals3(0 To 2) As Double
Dim worldPos(0 To 2) As Double

DataType(0) = 1001: Data(0) = "Test_Application"
DataType(1) = 1000: Data(1) = "This is a test for xdata"
DataType(2) = 1003: Data(2) = "0" 层
DataType(3) = 1040: Data(3) = 1.23479137438413E+40 实数
DataType(4) = 1041: Data(4) = 1237324938 距离
DataType(5) = 1070: Data(5) = 32767 16位整数
DataType(6) = 1071: Data(6) = 32767 32位整数
DataType(7) = 1042: Data(7) = 10 比例因子
reals3(0) = -2.95: reals3(1) = 100: reals3(2) = -20
DataType(8) = 1010: Data(8) = reals3 实数
worldPos(0) = 4: worldPos(1) = 400.99999999: worldPos(2) = 2.798989
DataType(9) = 1011: Data(9) = worldPos world space position
在直线上附着扩展数据
lineObj.SetXData DataType, Data

返回直线的扩展数据
Dim xdataOut As Variant
Dim xtypeOut As Variant
lineObj.GetXData "", xtypeOut, xdataOut
End Sub

示例：
Sub Example_XRecordData()
这个例子当扩展记录对象不存在时创建一个新的扩展记录对象，并且添加扩展记录数据。
Dim TrackingDictionary As AcadDictionary, TrackingXRecord As AcadXRecord
Dim XRecordDataType As Variant, XRecordData As Variant
Dim ArraySize As Long, iCount As Long
Dim DataType As Integer, Data As String, msg As String
Unique identifiers to distinguish our XRecordData from other XRecordData
Const TYPE_STRING = 1
Const TAG_DICTIONARY_NAME = "ObjectTrackerDictionary"
Const TAG_XRECORD_NAME = "ObjectTrackerXRecord"
连接扩展词典
On Error GoTo CREATE
Set TrackingDictionary = ThisDrawing.Dictionaries(TAG_DICTIONARY_NAME)
Set TrackingXRecord = TrackingDictionary.GetObject(TAG_XRECORD_NAME)
On Error GoTo 0
返回当前的扩展记录数据
TrackingXRecord.GetXRecordData XRecordDataType, XRecordData
If we dont have an array already then create one
If VarType(XRecordDataType) And vbArray = vbArray Then

14、文件系统的操作
文件系统对象（FileSystemObject）提供对计算机文件系统的访问。主要包含驱动器对象（Drive对象）、目录对象（Folder对象）、文件对象（File对象）和流对象（TextStream对象）。
FileSystemObject对象提供了几个对于文件操作的函数，如用FileExists方法判断指定的文件是否存在，用CreateTextFile创建一个指定文件名的文件，用OpenTextFile打开一个指定的文件等。
TextStream对象则对打开的文件进行操作，如用AtEndOfStream判断是否到达文件的末尾，用Read、ReadAll和ReadLine方法分别读取一定数量的字符、全部或者一行的内容，而用Skip、SkipLine方法跳过指定数量的字符或者一行，用Write、WriteBlankLines和WriteLine分别写入一定数量的字符、换行符或者一行。

更具体的可以参考VB的语言参考手册和VBScript的帮助文件。



FileSystemObject 示例代码

Copyright 1998 Microsoft Corporation。保留所有权利。



Option Explicit



对于代码质量：

1) 下面的代码有许多字符串操作，用"&"运算符来把短字符串连接在一起。由于
字符串连接是费时的，所以这是一种低效率的写代码方法。无论如何，它是
一种非常好维护的写代码方法，并且在这儿使用了这种方法，因为该程序执行
大量的磁盘操作，而磁盘操作比连接字符串所需的内存操作要慢得多。
记住这是示范代码，而不是产品代码。

2) 使用了 "Option Explicit"，因为访问声明过的变量，比访问未声明的变量要
稍微快一些。它还能阻止在代码中发生错误，例如，把 DriveTypeCDROM 误拼
成了 DriveTypeCDORM 。

3) 为了使代码更可读，该代码中没有错误处理。虽然采取了防范措施，来保证代码
在普通情况下没有错误，但文件系统是不可预知的。在产品代码中，使用
On Error Resume Next 和 Err 对象来捕获可能发生的错误。





一些容易取得的全局变量



Dim TabStop
Dim NewLine

Const TestDrive = "C"
Const TestFilePath = "C:\Test"



由 Drive.DriveType 返回的常数



Const DriveTypeRemovable = 1
Const DriveTypeFixed = 2
Const DriveTypeNetwork = 3
Const DriveTypeCDROM = 4
Const DriveTypeRAMDisk = 5



由 File.Attributes 返回的常数



Const FileAttrNormal = 0
Const FileAttrReadOnly = 1
Const FileAttrHidden = 2
Const FileAttrSystem = 4
Const FileAttrVolume = 8
Const FileAttrDirectory = 16
Const FileAttrArchive = 32
Const FileAttrAlias = 64
Const FileAttrCompressed = 128



用来打开文件的常数



Const OpenFileForReading = 1
Const OpenFileForWriting = 2
Const OpenFileForAppending = 8




ShowDriveType

目的：

生成一个字符串，来描述给定 Drive 对象的驱动器类型。

示范下面的内容

- Drive.DriveType



Function ShowDriveType(Drive)

Dim S

Select Case Drive.DriveType
Case DriveTypeRemovable
S = "Removable"
Case DriveTypeFixed
S = "Fixed"
Case DriveTypeNetwork
S = "Network"
Case DriveTypeCDROM
S = "CD-ROM"
Case DriveTypeRAMDisk
S = "RAM Disk"
Case Else
S = "Unknown"
End Select

ShowDriveType = S

End Function



ShowFileAttr

目的：

生成一个字符串，来描述文件或文件夹的属性。

示范下面的内容

- File.Attributes
- Folder.Attributes



Function ShowFileAttr(File) File 可以是文件或文件夹

Dim S
Dim Attr

Attr = File.Attributes

If Attr = 0 Then
ShowFileAttr = "Normal"
Exit Function
End If

If Attr And FileAttrDirectory Then S = S & "Directory "
If Attr And FileAttrReadOnly Then S = S & "Read-Only "
If Attr And FileAttrHidden Then S = S & "Hidden "
If Attr And FileAttrSystem Then S = S & "System "
If Attr And FileAttrVolume Then S = S & "Volume "
If Attr And FileAttrArchive Then S = S & "Archive "
If Attr And FileAttrAlias Then S = S & "Alias "
If Attr And FileAttrCompressed Then S = S & "Compressed

DeleteTestDirectory

目的：

清理 test 目录。

示范下面的内容

- FileSystemObject.GetFolder
- FileSystemObject.DeleteFile
- FileSystemObject.DeleteFolder
- Folder.Delete
- File.Delete



Sub DeleteTestDirectory(FSO)

Dim TestFolder
Dim SubFolder
Dim File

有两种方法可用来删除文件：

FSO.DeleteFile(TestFilePath & "\Beatles\OctopusGarden.txt")

Set File = FSO.GetFile(TestFilePath & "\Beatles\BathroomWindow.txt")
File.Delete



有两种方法可用来删除文件夹：

FSO.DeleteFolder(TestFilePath & "\Beatles")

FSO.DeleteFile(TestFilePath & "\ReadMe.txt")

Set TestFolder = FSO.GetFolder(TestFilePath)
TestFolder.Delete

End Sub



CreateLyrics

目的：

在文件夹中创建两个文本文件。


示范下面的内容

- FileSystemObject.CreateTextFile
- TextStream.WriteLine
- TextStream.Write
- TextStream.WriteBlankLines
- TextStream.Close



Sub CreateLyrics(Folder)

Dim TextStream

Set TextStream = Folder.CreateTextFile("OctopusGarden.txt")

TextStream.Write("Octopus Garden ") 请注意，该语句不添加换行到文件中。
TextStream.WriteLine("(by Ringo Starr)")
TextStream.WriteBlankLines(1)
TextStream.WriteLine("Id like to be under the sea in an octopus garden in the shade,")
TextStream.WriteLine("Hed let us in, knows where weve been -- in his octopus garden in the shade.")
TextStream.WriteBlankLines(2)

TextStream.Close

Set TextStream = Folder.CreateTextFile("BathroomWindow.txt")
TextStream.WriteLine("She Came In Through The Bathroom Window (by Lennon/McCartney)")
TextStream.WriteLine("")
TextStream.WriteLine("She came in through the bathroom window protected by a silver spoon")
TextStream.WriteLine("But now she sucks her thumb and wanders by the banks of her own lagoon")
TextStream.WriteBlankLines(2)
TextStream.Close

End Sub



GetLyrics

目的：

显示 lyrics 文件的内容。


示范下面的内容

- FileSystemObject.OpenTextFile
- FileSystemObject.GetFile
- TextStream.ReadAll
- TextStream.Close
- File.OpenAsTextStream
- TextStream.AtEndOfStream
- TextStream.ReadLine



Function GetLyrics(FSO)

Dim TextStream
Dim S
Dim File

有多种方法可用来打开一个文本文件，和多种方法来从文件读取数据。
这儿用了两种方法来打开文件和读取文件：

Set TextStream = FSO.OpenTextFile(TestFilePath & "\Beatles\OctopusGarden.txt", OpenFileForReading)

S = TextStream.ReadAll & NewLine & NewLine
TextStream.Close

Set File = FSO.GetFile(TestFilePath & "\Beatles\BathroomWindow.txt")
Set TextStream = File.OpenAsTextStream(OpenFileForReading)
Do While Not TextStream.AtEndOfStream
S = S & TextStream.ReadLine & NewLine
Loop
TextStream.Close

GetLyrics = S

End Function




BuildTestDirectory

目的：

创建一个目录分层结构来示范 FileSystemObject。

以这样的次序来创建分层结构：

C:\Test
C:\Test\ReadMe.txt
C:\Test\Beatles
C:\Test\Beatles\OctopusGarden.txt
C:\Test\Beatles\BathroomWindow.txt


示范下面的内容

- FileSystemObject.DriveExists
- FileSystemObject.FolderExists
- FileSystemObject.CreateFolder
- FileSystemObject.CreateTextFile
- Folders.Add
- Folder.CreateTextFile
- TextStream.WriteLine
- TextStream.Close



Function BuildTestDirectory(FSO)

Dim TestFolder
Dim SubFolders
Dim SubFolder
Dim TextStream

排除(a)驱动器不存在，或(b)要创建的目录已经存在的情况。

If Not FSO.DriveExists(TestDrive) Then
BuildTestDirectory = False
Exit Function
End If

If

15、Excel文件的操作
Excel应用程序对象（Application）提供了对Excel应用程序控制的接口。它包括工作簿对象（Workbook对象），代表当前打开的一个Excel文件（文档）。而一个工作簿又包含了一些工作表对象（Worksheet对象），代表工作簿中的一张工作表。Cell代表工作表中的一个单元格，而Range是由一个或者多个单元格构成的区域。

在 Excel 电子表格中列出 AutoCAD 属性
以下子例程在当前图形中查找所有的块引用，然后查找附着到这些块引用的属性，并将它们列在 Excel 电子表格中。要运行本样例，请按以下步骤执行：
1. 打开包含块引用的图形，这些块引用带有属性。（样例图形 sample/activeX/attrib.dwg 包含这样的块引用。）
2. 使用 AutoCAD VBAIDE 命令打开 VBA IDE。
3. 使用 VBA IDE 中的“工具” “引用”菜单选项，选择 Microsoft Excel 8.0 对象模型。
4. 将这个子例程复制到 VBA 的“代码”窗口中并运行它。
Sub Ch12_Extract()
Dim Excel As Excel.Application
Dim ExcelSheet As Object
Dim ExcelWorkbook As Object

Dim RowNum As Integer
Dim Header As Boolean
Dim elem As AcadEntity
Dim Array1 As Variant
Dim Count As Integer

启动 Excel。
Set Excel = New Excel.Application

创建新的工作簿并查找活动电子表格。
Set ExcelWorkbook = Excel.Workbooks.Add
Set ExcelSheet = Excel.ActiveSheet
ExcelWorkbook.SaveAs "Attribute.xls"

RowNum = 1
Header = False
遍历模型空间，查找
所有的块引用。
For Each elem In ThisDrawing.ModelSpace
With elem
找到块引用时，
检查其属性
If StrComp(.EntityName, "AcDbBlockReference", 1) _
= 0 Then
If .HasAttributes Then
获取属性
Array1 = .GetAttributes
将属性的标记字符串
复制到 Excel
For Count = LBound(Array1) To UBound(Array1)
If Header = False Then
If StrComp(Array1(Count).EntityName, _
"AcDbAttribute", 1) = 0 Then
ExcelSheet.Cells(RowNum, _
Count + 1).value = _
Array1(Count).TagString
End If
End If
Next Count
RowNum = RowNum + 1
For Count = LBound(Array1) To UBound(Array1)
ExcelSheet.Cells(RowNum, Count + 1).value _
= Array1(Count).textString
Next Count
Header = True
End If
End If
End With
Next elem
Excel.Application.Quit
End Sub
16、使用ADO操作Access数据库
ADO的Connection对象提供了连接数据库的方法，也可以看做是对数据库进行控制的接口。它主要包括数据集对象（Recordset对象），代表返回数据库中的数据记录，还有命令对象（Command对象），执行一些SQL语句。
Connection对象的Provider属性是提供者的名称，ConnectionString属性是建立到数据源的连接的信息。Open方法是打开到数据源的连接，Execute方法是执行指定的SQL语句。
Recordset对象的Open方法是返回表的记录或者执行SQL语句查询等的结果。
Command对象的Execute方法是执行SQL语句，如插入、更新、删除记录等。

示例：
Public Sub Example_ADO()

Dim cnn As ADODB.Connection
Set cnn = New ADODB.Connection

打开连接
1、在连接字符串外指定提供者
cnn.Provider = "Microsoft.Jet.OLEDB.3.51"
strCnn = "Data Source=c:\MyDb.mdb;"
cnn.Open strCnn

2、在Open语句外指定连接字符串
cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=c:\MyDb.mdb;"
cnn.Open

strCnn = "Provider=Microsoft.Jet.OLEDB.3.51;" & _
"Data Source= c:\MyDb.mdb;"
cnn.Open strCnn

Dim rst As

很好！就是下载麻烦！

不麻烦，Ctrl+C就搞定。

详细

难学