用Vlisp来读取AutoCAD中搜索路径
(vla-get-supportpath (vla-get-files (vla-get-preferences (vlax-get-acad-object))))
或：
(getenv "ACAD")
或：
(acet-pref-supportpath-list)获取支持路径。

用LISP打开WINDOWS的选择目录对话框
方法有5种:
a.(setq bmpdir (xdrx_getdir "选择目录" "" "请选取目录" ))
b.(dos_getdir "选择目录:" "c:\\")
c.(setq picdir (Odcl_BrowseFolder "选取文件目录" ""))
d.(acet-ui-pickdir "选择目录" "" "请指定目录")
e:
Code:
(defun qf_getFolder (msg / WinShell shFolder path catchit)
(vl-load-com)
(setq winshell (vlax-create-object "Shell.Application"))
; (vlax-dump-object winshell T)
(setq shFolder (vlax-invoke-method WinShell ’BrowseForFolder 0 msg 1))
(setq
catchit (vl-catch-all-apply
’(lambda ()
(setq shFolder (vlax-get-property shFolder ’self))
(setq path (vlax-get-property shFolder ’path))
)
)
)
(if (vl-catch-all-error-p catchit)
nil
path
)
)

捕获列表框（list_box）的双击操作
在edit_box,list_box,image_button,slider中，有一个$reason变量，用来
表示你执行了什么操作 。在list_box中，双击的变量值是4。
可在你的代码中加入判断：
(action_tile "listbox" "(fun1).....")
(defun fun1()
.....
(if (= $reason 4)
.....
)
.....
)

用VLISP创建目录
A. (vl-mkdir "c:\\hqd9639")

B. (setq SYS (vlax-create-object "Scripting.FileSystemObject"))
(setq FOLDER (vlax-invoke-method SYS ’CREATEFOLDER "c:\\hqd9639"))

用Vlisp来读取AutoCAD中搜索路径

(vla-get-supportpath (vla-get-files (vla-get-preferences (vlax-get-acad-object))))
或：
(getenv "ACAD")
或：
(acet-pref-supportpath-list)获取支持路径。

在AutoCAD中动态读取Excel数据

在实际的工作中，我们经常要对一些表格数据进行处理，如果先把这些表格数据通过Excel处理，再导入到AutoCAD，
那绝对会起到事半功倍的效果。随着Automation编程技术的出现，我们可以很方便地实现这一点了，下面是个
ObjectARX的例子，其功能是动态关联Excel，然后读取其数据，并将这些数据打印在文本域中。

//动态从Excel读取数据
int DynamicReadFromExcel()
{
//常用变量定义
_Application app;
Workbooks books;
_Workbook book;
Worksheets sheets;
_Worksheet sheet;
Range range;
Range iCell;

LPDISPATCH lpDisp;
COleVariant
covTrue((short)TRUE),
covFalse((short)FALSE),
covOptional((long)DISP_E_PARAMNOTFOUND, VT_ERROR);
COleVariant vResult;

//采用MFC方式初始化COM库，程序结束时COM库会自动释放
if(!AfxOleInit())
{
MessageBox(NULL,"初始化COM支持库失败!\n无法控制Excel!", \
"TrueTable",MB_IConERROR | MB_OK);
return RTERROR;
}

//关联已经运行的Excel实例
CLSID clsid;
CLSIDFromProgID(L"Excel.Application", &clsid);
IUnknown *pUnk = NULL;
IDispatch *pRunDisp = NULL;

for(long i=1;i<=5;i++) //做5次尝试
{
HRESULT hr = GetActiveObject(clsid, NULL, (IUnknown**)&pUnk);
if(SUCCEEDED(hr))
{
hr = pUnk->QueryInterface(IID_IDispatch, (void **)&pRunDisp);
break;
}
::Sleep(10);
}

if (!pRunDisp)
{
::MessageBox(NULL, "没有发现Excel!", "TrueTable", MB_ICONHAND);
return RTERROR;
}

if (pUnk) pUnk->Release();

//关联Excel
app.AttachDispatch (pRunDisp);

//得到当前活跃sheet
//如果有单元格正处于编辑状态中，此操作不能返回，会一直等待
lpDisp=app.GetActiveSheet();
if(lpDisp==NULL)
{
MessageBox(NULL, "没有发现有效的表格!", \
"TrueTable",MB_IConERROR | MB_OK);
app.ReleaseDispatch ();

return RTERROR;
}
sheet.AttachDispatch(lpDisp);

//已经使用的行数:
long row_num;
range.AttachDispatch(sheet.GetUsedRange());
range.AttachDispatch(range.GetRows());
row_num=range.GetCount();


//已经使用的列数:
long col_num;
range.AttachDispatch(sheet.GetUsedRange());
range.AttachDispatch(range.GetColumns());
col_num=range.GetCount();

//已经使用区域的起始行、列：
range.AttachDispatch(sheet.GetUsedRange());
long StartRow=range.GetRow(); //起始行
long StartCol=range.GetColumn(); //起始列

//读取sheet名
CString SheetName=sheet.GetName();
//ads_printf("\n%s",SheetName);
if(col_num<2 && row_num<2) //此sheet为空
{
MessageBox(NULL,"\n当前表格没有数据!", \
"TrueTable",MB_IConERROR | MB_OK);
app.ReleaseDispatch ();

return RTERROR;

}
else
{
ads_printf("\n表格%s共%d行,%d列",SheetName,row_num,col_num);
}



//得到全部Cells，此时,range是cells的集合
range.AttachDispatch(sheet.GetCells());


//读写数据了
CString cstr;
ads_printf("\n");
for(long i=StartRow;i<StartRow+row_num;i++)
{

for(long j=StartCol;j<StartCol+col_num;j++)
{

//读取单元格文本
iCell.AttachDispatch(range.GetItem (COleVariant(i),COleVariant(j)).pdispVal );
vResult =iCell.GetText();
cstr=vResult.bstrVal;

//写单元格文本
ads_printf("%s ",(LPTSTR)cstr);

}
ads_printf("\n");
}


//释放Dispatch
iCell.ReleaseDispatch ();
range.ReleaseDispatch ();
sheet.ReleaseDispatch ();
sheets.ReleaseDispatch ();
book.ReleaseDispatch ();
books.ReleaseDispatch ();
app.ReleaseDispatch ();

return RTNORM;

}

如果要输出到Excel的话，关键函数就是：
iCell.SetItem(COleVariant(i),COleVariant(j),COleVariant(cstr));

在VC中彻底玩转Excel


如今Excel是越来越重要了，在我们自己开发的程序中不免要和Excel打交道了。利用Automation技术，我们可以在不去了解数据库的情况下玩转Excel，而且你会发现一切竟如此轻松！
好了，咱们开始吧，我不喜欢用长篇累牍的代码来故弄玄虚，所以下面的代码都是切中要害的片段，总体上是个连贯的过程，包括启动Excel，读取数据，写入数据，以及最后的关闭Excel，其中还包括了很多人感兴趣的合并单元格的处理。
特别说明以下代码需要MFC的支持，而且工程中还要包含EXCEL2000的定义文件：EXCEL9.H，EXCEL9.CPP

******************************************************************************

//*****
//变量定义
_Application app;
Workbooks books;
_Workbook book;
Worksheets sheets;
_Worksheet sheet;
Range range;
Range iCell;
LPDISPATCH lpDisp;
COleVariant vResult;
COleVariant
covTrue((short)TRUE),
covFalse((short)FALSE),
covOptional((long)DISP_E_PARAMNOTFOUND, VT_ERROR);


//*****
//初始化COM的动态连接库
if(!AfxOleInit())
{
AfxMessageBox("无法初始化COM的动态连接库!");
return ;
}


//*****
//创建Excel 2000服务器(启动Excel)
if(!app.CreateDispatch("Excel.Application"))
{
AfxMessageBox("无法启动Excel服务器!");
return;
}

app.SetVisible(TRUE); //使Excel可见
app.SetUserControl(TRUE); //允许其它用户控制Excel


//*****
//打开c:\1.xls
books.AttachDispatch(app.GetWorkbooks());
lpDisp = books.Open("C:\\1.xls",
covOptional, covOptional, covOptional, covOptional, covOptional,
covOptional, covOptional, covOptional, covOptional, covOptional,
covOptional, covOptional );


//*****
//得到Workbook
book.AttachDispatch(lpDisp);


//*****
//得到Worksheets
sheets.AttachDispatch(book.GetWorksheets());


//*****
//得到当前活跃sheet
//如果有单元格正处于编辑状态中，此操作不能返回，会一直等待
lpDisp=book.GetActiveSheet();
sheet.AttachDispatch(lpDisp);


//*****
//读取已经使用区域的信息，包括已经使用的行数、列数、起始行、起始列
Range usedRange;
usedRange.AttachDispatch(sheet.GetUsedRange());
range.AttachDispatch(usedRange.GetRows());
long iRowNum=range.GetCount(); //已经使用的行数

range.AttachDispatch(usedRange.GetColumns());
long iColNum=range.GetCount(); //已经使用的列数

long iStartRow=usedRange.GetRow(); //已使用区域的起始行，从1开始
long iStartCol=usedRange.GetColumn(); //已使用区域的起始列，从1开始


//*****
//读取第一个单元格的值
range.AttachDispatch(sheet.GetCells());
range.AttachDispatch(range.GetItem (COleVariant((long)1),COleVariant((long)1)).pdispVal );
COleVariant vResult =range.GetValue();
CString str;
if(vResult.vt == VT_BSTR) //字符串
{
str=vResult.bstrVal;
}
else if (vResult.vt==VT_R8) //8字节的数字
{
str.Format("%f",vResult.dblVal);
}
else if(vResult.vt==VT_DATE) //时间格式
{
SYSTEMTIME st;
VariantTimeToSystemTime(&vResult.date, &st);
}
else if(vResult.vt==VT_EMPTY) //单元格空的
{
str="";
}


//*****
//读取第一个单元格的对齐方式，数据类型:VT_I4
//读取水平对齐方式
range.AttachDispatch(sheet.GetCells());
iCell.AttachDispatch((range.GetItem (COleVariant(long(1)), COleVariant(long(1)))).pdispVal);
vResult.lVal=0;
vResult=iCell.GetHorizontalAlignment();
if(vResult.lVal!=0)
{
switch (vResult.lVal)
{
case 1: //默认
break;
case -4108: //居中
break;
case -4131 : //*左
break;
case -4152 : //*右
break;
}

}

//垂直对齐方式
iCell.AttachDispatch((range.GetItem (COleVariant(long(1)), COleVariant(long(1)))).pdispVal);
vResult.lVal=0;
vResult=iCell.GetVerticalAlignment();
if(vResult.lVal!=0)
{
switch (vResult.lVal)
{
case -4160 : //*上
break;
case -4108 : //居中
break;
case -4107 : //*下
break;
}

}

在VC中彻底玩转Excel -2
//*****
//设置第一个单元格的值"HI,EXCEL!"
range.SetItem(COleVariant(1),COleVariant(1),COleVariant("HI,EXCEL!"));


//*****
//设置第一个单元格字体颜色:红色
Font font;
range.AttachDispatch(sheet.GetCells());
range.AttachDispatch((range.GetItem (COleVariant(long(1)), COleVariant(long(1)))).pdispVal);
font.SetColor(COleVariant((long)0xFF0000));


//*****
//合并单元格的处理
//包括判断第一个单元格是否为合并单元格，以及将第一个单元格进行合并
Range unionRange;
range.AttachDispatch(sheet.GetCells());
unionRange.AttachDispatch(range.GetItem (COleVariant((long)1),COleVariant((long)1)).pdispVal );

vResult=unionRange.GetMergeCells();
if(vResult.boolVal==-1) //是合并的单元格
{
//合并单元格的行数
range.AttachDispatch (unionRange.GetRows ());
long iUnionRowNum=range.GetCount ();

//合并单元格的列数
range.AttachDispatch (unionRange.GetColumns ());
long iUnionColumnNum=range.GetCount ();

//合并区域的起始行，列
long iUnionStartRow=unionRange.GetRow(); //起始行，从1开始
long iUnionStartCol=unionRange.GetColumn(); //起始列，从1开始

}
else if(vResult.boolVal==0)
{//不是合并的单元格}

//将第一个单元格合并成2行，3列
range.AttachDispatch(sheet.GetCells());
unionRange.AttachDispatch(range.GetItem (COleVariant((long)1),COleVariant((long)1)).pdispVal );
unionRange.AttachDispatch(unionRange.GetResize(COleVariant((long)2),COleVariant((long)3)));
unionRange.Merge(COleVariant((long)0)); //合并单元格


//*****
//将文件保存为2.xls
book.SaveAs(COleVariant("C:\\2.xls"),covOptional,covOptional, \
covOptional,covOptional,covOptional,0,\
covOptional,covOptional,covOptional,covOptional);


//*****
//关闭所有的book，退出Excel
book.Close (covOptional,COleVariant(OutFilename),covOptional);
books.Close();
app.Quit();

AutoCad与Excel的连接及明细表的输出

一、 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． 单击“确定”按钮

2



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、 创建成下面的过程及代码，并运行之

SubBlkAttr_Extract()
DimExcelAsExcel.Application
DimExcelSheetAsObject
DimExcelWorkbookAsObject
’创建Excel应用程序实例
onErrorResumeNext
SetExcel = GetObject(, "Excel.Application")
IfErr <> 0Then
SetExcel = CreateObject("Excel.Application")
EndIf
’创建一个新工作簿
SetExcelWorkbook = Excel.Workbooks.Add
’确保Sheet1工作表为当前工作表
SetExcelSheet = Excel.ActiveSheet
’将新创建的工作簿保存为Excel文件
ExcelWorkbook.SaveAs "属性表.xls"
’令Excel应用程序可见
DimRowNumAsInteger
DimHeaderAsBoolean
DimblkElemAsAcadEntity
DimArray1AsVariant
DimCountAsInteger
RowNum = 1
Header = False
’遍历模型空间，查找明细表的每个块引用表行
For bEachblkElemInThisDrawing.ModelSpace
WithblkElem
’当一个块引用表行被找到后，检查它是否有属性
IfStrComp(.EntityName, "AcDbBlockReference", 1) = 0Then
’如果有属性
If . HasAttributesThen
’提取块引用中的属性
Array1 = .GetAttributes
’这一轮循环用来查找标题，如果有填在第1行
ForCount = LBound(Array1)ToUBound(Array1)
’如果还没有标题
IfHeader = FalseThen
’作为标题的明细行其块属性常设为Constant类型
IfArray1(Count).ConstantThen
ExcelSheet.Cells(RowNum, Count + 1).Value _
= Array1(Count).TextString
EndIf
EndIf
NextCount
’从第2行开始，填写其它的明细表行内容
RowNum = RowNum + 1
ForCount = LBound(Array1)ToUBound(Array1)
ExcelSheet.Cells(RowNum, Count + 1).Value _
= Array1(Count).TextString
NextCount
Header = True
EndIf
EndIf
EndWith
NextblkElem
’对填入当前表单的内容，按第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上运行通过。