[转贴]：利用VBA 建立AutoCad2000与Excel通信

sunxue316

一、 Excel 的ActiveX对象模型：

1． WorkBooks集合对象

一个WorkBook对象实际上就是一个Excel文件，Excel应用程序可以同时打开或创建多个文件，它们被保存在WorkBooks集合对象中，可以通过索引号或名称访问集合中的任何一个工作簿，如下语句所示：

'该语句激活WorkBooks集合中的第一个工作簿，使其成为当前工作簿

WorkBooks(1).Activate

'该语句激活WorkBooks集合中的Mybook.xls工作簿，使其成为当前工作簿

WorkBooks("Mybook.xls"). Activate

2.Worksheets对象

每个工作簿对象上可以有多个工作表WorkSheet。在默认情况下, Excel的当前工作簿上有名为Sheet1,Sheet2,Sheet3三个工作表，并且Sheet1为当前工作表。如果想使Sheet2成为当前工作表，则可使用下列语句:

ExcelApp.Worksheets("Sheet2").Activate

3.Range对象

该对象用来指定工作表上的区域。将单元格A1的值赋给单元格A5的语句说明如下：

Worksheets("sheet1").range("A5").value=worksheets("sheet1").range("A1").value]

上述语句将Sheet1工作表上的A1（第1行第1列）单元格中的值，赋给Sheet1工作表上的A5（第5行第1列）单元格。

再看下面的语句：

‘将单元格A1和D26构成的区域选中

worksheets("sheet1").range("a1:d26").select

这条语句中的Select方法所产生的效果，与我们平时用鼠标在屏幕上将A1：D26区域上的单元格进行刷黑选择是一样的。Rnge对象的另一个重要方法是Sort，该方法用来对工作表上选定的区域进行排序，它带有许多参数，下面我们看一下该方法的语法格式：

Expression.sort(Key1,Order1,Key2,Type,Order2,Key3,Order3,Header,OrderCustom,_

MatchCase,Orientation,SortMethod,IgnoreControlCharacters,IgnoreDiacritics,IgnoreKashide)

其中：

expression：必选参数。该表达式返回Rang对象选定的区域。

Key1：Variant类型，可选参数。第一个排序字段，主要是Rang对象返回的区域或由工作表对象的Columns属性指定的列。

Order1：Variant类型，可选参数。可为下例xlSortOrder内置常量之一, xlAscending或xlDescending。用xlAscending表示以升序排列Key1。用xlDescending表示以降序排列Key1。默认值为升序xlAscending。

Key2：Variant类型，可选参数。第二个排序字段，主要是Rang对象返回的区域或由工作表对象Columns的属性指定的列。如果省略本参数，则没有第二个排序字段。对数据透视表排序时不用。

Type：Varoant类型，可选参数。指定参与排序的要素。可为下列xlSortType常量之一：xlSortValues或xlSortLabels。仅用于对数据透视表的排序。

Order2：Variant类型。可选参数。可为下列XlSortOrder常量之一：xlDescending或xlDescending。用xlAscending表示以升序排列Key2。用xldescending表示以降序排列Key2。默认值为xlAscending。对数据透视表排序时不用。

Key3：Variant类型，可选参数。第三个排序字段，主要是Rang对象返回的区域或由工作表对象的Columns属性指定的列。如果省略本参数，则没有第三个排序字段。对数据透视表排序时不用。

Order3：Variant类型，可选参数。可为下列xlSortOrder常量之一：xlAscending或xlDescending。用xlAscending表示以升序排列Key3，用xlDescending表示以降序排列Key3。默认值为xlAscending。对数据透视有排序时不用。

Heard：Variant类型，可选取参数。指定第一行时否包含标题。可为下列xlYesNoGuess常量之一：xlYes、xlNo或xlGuess。如果首行包含标题（不对首行排序），就指定xlYes。如果首行不包含标题（对整个区域排序），就指定xlNo。若指定为xlGuess，将由Microsoft Excel判断是否有标题及标题位于何处。默认值为xlNo。对数据透视表排序时不用。

OrderCustom：Variant类型，可选参数。以从1开始的整数指定在自定义排序顺序列表中的索引号。如果省略本参数，就使用不着1（“常规：“）。

MatchCase：Variant类型，可选。若指定为True，则进行区分大小写的排序；若指定为False，则排序时不区分大小写。对数据透视表排序时不用。

Orientation：Variant类型，可选参数。如果指定为xlTopToBottom，排序将从上到下（按行）进行。如果指定为xlLeftToRight，排序将从左到右（按列）进行。

SortMethod：Variant类型，可选参数。排序方式。可为下列xlSortMethod常量之一：xlSyllabary（按发音排序）或xlCodePage（按代码页排序）。默认值为xlSyllabary。

IgnoreControlCharacters：Variant类型，可选参数。不用于美国英语版的Microsoft Excel中。

IgnoreDiacritics:Variant类型，可选参数，不用于美国英语版的Microsoft Excel中。

IgnoreKashida：Variant类型，可选参数。不用于美国英语版的Microsoft Excel中。

下面语句是有关使用Sort方法的2个示例。

示例1：对工作表“Sheet1”上的单元格区域A1：C20进行排序，用单元格A1作为第一关键字，用单元格B1作为第二关键盘字。排序是按行以升序（默认）进行的，没有标题。

Worksheets("sheet1").range(A1:c20").sort,key1:=worksheets("sheet1").range("A1"),key2:=_

Worksheets("sheet1").range("B1")

示例2、对工作表“Sheet1“上包含单元格“A1”的当前区进行排序，按第一列中的数据进行排序，并且自动判断是否存在标题行。Sort方法将自动判断当前区。

Worksheets("Sheet1").Range("A1").Sort,Key1:=Workssheets("Sheet1").Columns("A"),_

Header:=xlGuess

4．Cells属性

工作表对象中的Cells属性，在单元格的选择方面可以达到与Rang相同的效果它是以行Row和列Gol作为参数的，如下语句所示：

‘将单元格A1的值赋给单元格A5

Worksheets("Sheet1").Cells(5,1).Value=Worksheets("Sheet1").Cells(1,1).Value

上面语句即将第1行第1列（A1）单元格内的值，赋给第5行第1列（A5）单元格。Cells属性的优点是，对于行和列的选择可以采用变量，如下语句所示：

Worksheets("Sheet1").Activate

For theYear=1 to 5

Cells(1,theYear+1).Value=1990+theYear

Next theYear

上述语句将在当前工作表的第一行的第2、3、4、5、6列，分别添上1992、1993、1994、1995和1996的值。注意，由于第1条语句已将Sheet1设为当前工作簿，所以Cells属性可以不必显示指定工作表。

5．GetObject和CreateObject函数

二、在AutoCad创建Excel应用程序

1． 打开AutoCad的VBA编辑器

2． 选择“工具”\“引用”项，在弹出的“引用”对话框的“可使用的引用”列表框内，选择“Microsoft Excel 8.0 Object Library"项

3． 单击“确定”按钮

4． 接下来使用下列代码就可创建完整的应用程序对象实例：

Dim ExcelApp as Excel.Application

'激活要与之通信的Excel应用程序

On Error Resume Next

Set ExcelApp=GetObject( , "Excel.Application")

If Err<>0 Then

Set ExcelApp=CreateObject("Excel.Applicationn")

End If

注意GetObject和CreateObject函数的区别。当Excel程序已经在运行时，前者可以马上创建Excel应用程序的实例，这样不会出现2个Excel应用程序对象实例，这将有效地节省系统资源的开销。如果当前Excel没有运行，GetObject函数将出错，紧接着Err将捕获错误，并运行CreateObject函数创建一个Excel应用程序实例，所以在具体使用时，这2个函数最好都不要省略。

三、将明细表做成一个Excel报表

1、 运行AutoCad2000程序

2、 打开AutoCad2000主运行文件夹下的“\Sample\Actives\ExtAtt\attrib.dwg”文件。该文件的右上角有一明细表，该明细表的每一行都是一个插入的块引用，显示的文字就是块的属性文本或标签（主要用于标题）

3、 创建成下面的过程及代码，并运行之

Sub BlkAttr_Extract()
Dim Excel As Excel.Application
Dim ExcelSheet As Object
Dim ExcelWorkbook As Object
'创建Excel应用程序实例
On Error Resume Next
Set Excel = GetObject(, "Excel.Application")
If Err <> 0 Then
Set Excel = CreateObject("Excel.Application")
End If
'创建一个新工作簿
Set ExcelWorkbook = Excel.Workbooks.Add
'确保Sheet1工作表为当前工作表
Set ExcelSheet = Excel.ActiveSheet
'将新创建的工作簿保存为Excel文件
ExcelWorkbook.SaveAs "属性表.xls"
'令Excel应用程序可见
Dim RowNum As Integer
Dim Header As Boolean
Dim blkElem As AcadEntity
Dim Array1 As Variant
Dim Count As Integer
RowNum = 1
Header = False
'遍历模型空间，查找明细表的每个块引用表行
For bEach blkElem In ThisDrawing.ModelSpace
With blkElem
'当一个块引用表行被找到后，检查它是否有属性
If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then
'如果有属性
If . HasAttributes Then
'提取块引用中的属性
Array1 = .GetAttributes
'这一轮循环用来查找标题，如果有填在第1行
For Count = LBound(Array1) To UBound(Array1)
'如果还没有标题
If Header = False Then
'作为标题的明细行其块属性常设为Constant类型
If Array1(Count).Constant Then
ExcelSheet.Cells(RowNum, Count + 1).Value _
= Array1(Count).TextString
End If
End If
Next Count
'从第2行开始，填写其它的明细表行内容
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 blkElem
'对填入当前表单的内容，按第1列进行排序,
'范围是从A1单元格开始的整个工作表
Excel.Worksheets("Sheet1").Range("A1").Sort _
key1:=Excel.Worksheets("Sheet1").Columns("A"), _
Header:=xlGuess
'显示Excel工作表中的结果
Excel.Visible = True
'该语句用来等待查看显示结果
MsgBox "按‘确定’键将关闭Excel的运行！"
'保存传过来的数据
ExcelWorkbook.Save
'关闭Excel应用程序
Excel.Application.Quit
'删除Excel应用程序实例
Set Excel = Nothing
End Sub
运行上述代码后，将在“\My Documents”文件夹下生成一“属性表.xls”文件。由于在attrib.dwg文件中，其明细表中第一行标题的文字不是块属性，而是文本对象，所以在“属性表.xls”文件中的第1行为空。不过在Excel界面下要编写一行标题是非常容易的。在多数情况下，作为标题的明细表行是不希望随便改动的，所以标题行地块属性往往被设成固定不变(Constamt)类型。在ActiveX中的Attribute和AttributeRef对象，都有一个Constsnt属性，用来判断某个块或块引用中的属性值类型，它是一个布尔类型的值，其值若为True，表示块属性值为Constsnt类型。

本代码在Windows95\AutoCadR2000上运行通过。
:6