[建议]：Visual LISP与Excel电子表格

xtxb0713

Visual LISP与Excel电子表格

Microsoft Excel 在当今世界上的电子表格应用软件产品中占有绝对的统治地位。我们经常可以看到财会部门或人事部门利用它来处理日常的一些数据。虽然说 Access 在数据处理方面会比Excel好些，但它在一些简单的日常事务中象执行一些快速输入或排序时却不那么方便简单。它是一个常用的事务处理工具。

这10年来，有许多AutoCAD程序是用于将提取数据并将其输出为报告。不论什么原因，它是很必要的。近10年来所见到的除了极少部分外(如Terry Dotson的 http://www.dotsoft.com/), 输出的机制均为输出为 ASCII文本文件，或有些是带格式文件。这是因为10年来，我们没有 Visual LISP 或 VBA 使程序与其它应用软件相连通并在相互之间传递信息。现在可以了。

如果你还一直在使用逗号或TAB分界符的文本来区分你的数据，你应该好好地看看这篇文章了。

Visual LISP (VBA也可以) 提供了必要的函数来接触和与任何提供了类型库(内部暴露API[应用程序接口程序]的应用程序相联系。通常它是VB或VBA。这一类应用程序包括 Microsoft Office (Access, Excel, Word, 还有象Outlook 和 PowerPoint), 以及象 MathCAD, Visio、Actrix等产品。

在你的代码中的第一件事就是必需在Visual LISP中加载ActiveX/COM。它是通过(vl-load-com) 函数来完成的。第一件事尝试与 Excel 连接上就是搜索Excel的类型库文件。这里使用了Excel 2000 (9.0) 作为例子。示例1演示了怎样通过Excel不同版本来取得与其类型库相关联。注意 Excel 2002 用的是可执行文件来身来代替在以往版本中所使用的分离的TLB或OLB文件。


Figure 1: 加载Excel 97 类型库

(vl-load-com)
(defun DSX-TypeLib-Excel ( / sysdrv tlb)
(setq sysdrv (getenv "systemdrive"))
(cond
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel8.olb")))
tlb
)
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel9.olb")))
tlb
)
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel10.olb")))
tlb
)
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel.exe")))
tlb
)
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office10\\Excel.exe")))
tlb
)
)
)


下一步是加载类型库并定义内部接口的属性、方法和恒量。这些都可以使用任意名称的前缀，该前缀只是用于对外部应用程序的快速及合理地调用。

以下的文章内容将把类型库的前缀均置为斜体以方便区分。

示例2演示了一个简单的函数来加载类型库并判断是否成功返回T或nil：


Figure 2: 定义类型库接口

(defun DSX-Load-TypeLib-Excel ( / tlbfile tlbver out)
(cond
( (null msxl-xl24HourClock)
(if (setq tlbfile (DSX-TypeLib-Excel))
(progn
(setq tlbver (substr (vl-filename-base tlbfile) 6))
(cond
( (= tlbver "9")
(princ "\n初始化 Microsoft Excel 2000...") )
( (= tlbver "8")
(princ "\n初始化 Microsoft Excel 97...") )
( (= (vl-filename-base tlbfile) "Excel.exe")
(princ "\n初始化 Microsoft Excel XP...")
)
)
(vlax-import-type-library
:tlb-filename tlbfile
:methods-prefix "msxl-"
:properties-prefix "msxl-"
:constants-prefix "msxl-"
)
(if msxl-xl24HourClock (setq out T))
)
)
)
( T (setq out T) )
)
out
)

现在你已经在敲Excel的门并且得到“我在家!哪位，有什么事？”这样的回答。你必须温和地回答，象“你好!我这里有一个新的文件想存些数据进来!”

示例3给出了一个简单的函数来打开 Excel 并利用缺省的工作簿(一般为3个工作表)来创建一个新的空白工作簿。工作表1将作为缺省的活动工作表。该函数返回vla-object 指向新的 Excel 进程对象。


Figure 3: 打开带有新的工作簿的 Excel

;;; 注意: <dmode> 可以设为 "SHOW" (显示)或 "HIDE" (隐藏)，它取决于你希望
;;; Excel 进程是否可以让用户直接操作访问。
(defun DSX-Open-Excel-New (dmode / appsession)
(princ "\n创建一个新的 Excel 电子表格文件...")
(cond
( (setq appsession (vlax-create-object "Excel.Application"))
(vlax-invoke-method (vlax-get-property appsession 'WorkBooks) 'Add)
(if (= (strcase dmode) "SHOW")
(vla-put-visible appsession 1)
(vla-put-visible appsession 0)
)
)
)
appsession
)


经常用到的除了新建文件外还有打开现有的工作簿。示例4演示了怎样作为函数来调用实现该功能。注意文件名参数必须在调用该函数前检查过是存在的。

你可能也同时注意到了在这个示例中使用了(vlax-get-or-create-object)来代替在示例3中使用的(vlax-create-object)。这是一个历史学家独特的函数，在 Visual LISP程序中可能会经常不太注意到它。它会尝试获取现有的进程对象，如果找不到或失败，则会尝试新建一个。

它虽然价值不高，但它却能节省你键入好多的代码。如果你只想新建一个进程或只想取得现有的进程，你可以只将其替换为 (vlax-get-object) 或 (vlax-create-object) 。


Figure 4: 打开Excel 并在其中打开现有的文档文件

;;; 注意: <xfile> 必须为全路径文件名,
;;; <dmode> 可以设为 "SHOW" (显示)或 "HIDE" (隐藏)，它取决于你希望
;;; Excel 进程是否可以让用户直接操作访问。
(defun DSX-Open-Excel-Exist (xfile dmode / appsession)
(princ "\n打开 Excel 电子表格文件...")
(cond
( (setq fn (findfile xfile))
(cond
( (setq appsession (vlax-get-or-create-object "Excel.Application"))
(vlax-invoke-method
(vlax-get-property appsession 'WorkBooks)
'Open fn
)
(if (= (strcase dmode) "SHOW")
(vla-put-visible appsession 1)
(vla-put-visible appsession 0)
)
)
)
)
( T (alert (strcat "\n不能找到指定的文件: " xfile)) )
)
appsession
)


现在你已经打开了工作簿并进入活动的工作表中，你肯定还想进一步取在表中取点数据。



示例 5: 在活动的工作表中的单个单元格中获取数据

;;; 获取行<relrow> 和列 <relcol>范围内的单元格对象

(defun DSX-Excel-Get-Cell (rng relrow relcol)
(vlax-variant-value
(msxl-get-item (msxl-get-cells rng)
(vlax-make-variant relrow)
(vlax-make-variant relcol)
)
)
)

;;; 返回单元格(row, col)内容的值

(defun DSX-Excel-Get-CellValue (row col)
(vlax-variant-value
(msxl-get-value
(DSX-Excel-Get-Cell
(msxl-get-ActiveSheet xlapp)
row col
)
)
)
)



尽管获取单个单元格的值有时是足够的，但经常情况下你会要求一次性获取一个指定行列范围内的值。这里有一些函数用于从多行、多列或单元格数组获取值。



Figure 6: 在活动的工作表中获取一定行列范围中的数据

;;;*************************************************************************
;;; 模块: DSX-Excel-Get-RowValues
;;; 描述: 返回给定行的单元格值列表
;;; 参数: 行号(整数), 起始列, 单元格数量
;;; 样例: (DSX-Excel-Get-RowValues 3 1 20) 取得行3的前20个单元格的值
;;;*************************************************************************

(defun DSX-Excel-Get-RowValues (row startcol numcells / next out)
(setq next startcol)
(repeat numcells
(setq out
(if out
(append out (list (DSX-Excel-Get-CellValue row next))); row x col
(list (DSX-Excel-Get-CellValue row next)); row x col
)
next (1+ next)
)
); repeat
out
)

;;;*************************************************************************
;;; 模块: DSX-Excel-Get-ColumnValues
;;; 描述: 返回给定列的单元格值列表
;;; 参数: 列号(整数), 起始行, 单元格数量
;;; 样例: (DSX-Excel-Get-ColumnValues 2 1 20) 取得列2(“B”)的前20个单元格的值
;;;*************************************************************************
(defun DSX-Excel-Get-ColumnValues (col startrow numcells / next out)
(setq next startrow)
(repeat numcells
(setq out
(if out
(append out (list (DSX-Excel-Get-CellValue next col)))
(list (DSX-Excel-Get-CellValue next col))
)
next (1+ next)
)
); repeat
out
)

;;;*************************************************************************
;;; 模块: DSX-Excel-GetRangeValues-ByRows
;;; 描述: 按行顺序获得某一区域的值并返回嵌套的列表
;;; 参数: 起始行, 起始列, 行数, 列数
;;; 样例: (DSX-Excel-GetRangeValues-ByRows 1 1 5 10) 获取从1A到5J区域的值，每一子列表为一行
;;;*************************************************************************

(defun DSX-Excel-GetRangeValues-ByRows (startrow startcol numrows numcols / nextrow rowlst outlst)
(setq nextrow startrow)
(repeat numrows
(setq rowlst (DSX-Excel-Get-RowValues nextrow startcol numcols)
outlst (if outlst (append outlst (list rowlst)) (list rowlst))
nextrow (1+ nextrow)
)
)
outlst
)

;;;*************************************************************************
;;; 模块: DSX-Excel-GetRangeValues-ByCols
;;; 描述: 按列顺序获得某一区域的值并返回嵌套的列表
;;; 参数: 起始行, 起始列, 行数, 列数
;;; 样例: (DSX-Excel-GetRangeValues-ByCols 1 1 5 10) 获取从 1A到 5J区域的值，每一子列表为一列
;;;*************************************************************************

(defun DSX-Excel-GetRangeValues-ByCols (startrow startcol numrows numcols / nextrow nextcol collst outlst)
(setq nextcol startcol)
(repeat numcols
(setq collst (DSX-Excel-Get-ColumnValues nextcol startrow numrows)
outlst (if outlst (append outlst (list collst)) (list collst))
nextcol (1+ nextcol)
)
)
outlst
)

好了!现在可以从Excel中攫取数据了，但既然可以取数据，也应该可以写入数据才对，下面就介绍怎样将值填入到单元格中。示例7演示了怎样将列表值输入到一行或一列的单元格中。这可以很方便地让你将图形中的数据转到Excel中。这样可让你轻松地将图形中的内容输出到报告中让你的老板感受你惊人的天才。


示例 7: 将数据输入到工作表中

;;;*************************************************************************
;;; 模块: DSX-Excel-Put-ColumnList
;;; 描述: 将列表写到工作表指定列(startcol)中的指定起始行(startrow)
;;; 参数: list, startrow, startcol
;;; 样例: (DSX-Excel-Put-ColumnList '("A" "B" "C") 1 2) 将数据分别输出到单元格(1,B) (2,B) (3,B)中
;;;*************************************************************************

(defun DSX-Excel-Put-ColumnList (lst startrow startcol)
(foreach itm lst
(msxl-put-value
(DSX-Excel-Get-Cell range startrow startcol)
itm
)
(setq startrow (1+ startrow))
); repeat
)

;;;*************************************************************************
;;; 模块： DSX-Excel-Put-RowList
;;; 描述： 将列表写到工作表指定行(startrow) 中的指定起始列(startcol)
;;; 参数： list, startrow, startcol
;;; 示例： (DSX-Excel-Put-RowList '("A" "B" "C") 2 1) 将数据分别输出到单元格(1,B) (1,C) (1,D)中
;;;*************************************************************************

(defun DSX-Excel-Put-RowList (lst startrow startcol)
(foreach itm lst
(msxl-put-value
(DSX-Excel-Get-Cell range startrow startcol)
itm
)
(setq startcol (1+ startcol))
); repeat
)

单独的数据将不会给你留下多深的印象。就是你输入“一个老板”也是一样的。你必须增加一些颜色给它，还有就是加些格式。让它漂亮起来!示例8给出了一些怎样一次性添加颜色给单元格或整行或整列。注意EXCEL的颜色调色板和AutoCAD是不一样的。你必须无能为力钻研Excel的在线帮助并找到你需要的颜色索引。


示例8: 更改Excel单元格的属性(颜色)

;;;*************************************************************************
;;; 模块： DSX-Excel-Put-CellColor
;;; 描述： 为指定单元格填入颜色
;;; 参数： row, column, color (integer)
;;; 示例： (DSX-Excel-Put-CellColor 1 1 14) 将颜色#14填入到单元格(1,A)
;;;*************************************************************************

(defun DSX-Excel-Put-CellColor (row col intcol / rng)
(setq rng (DSX-Excel-Get-Cell (msxl-get-ActiveSheet xlapp) row col))
(msxl-put-colorindex (msxl-get-interior rng) intcol)
)


;;;*************************************************************************
;;; 模块： DSX-Excel-Put-RowCellsColor
;;; 描述： 为一行单元格填入颜色
;;; 参数： startrow, startcol, num-cols, color (integer)
;;; 示例： (DSX-Excel-Put-RowCellsColor 1 1 5 14) 从行=1、列=1开始连接5列使用颜色#14
;;;*************************************************************************

(defun DSX-Excel-Put-RowCellsColor (startrow startcol cols intcol / next)
(setq next startcol)
(repeat cols
(DSX-Excel-Put-CellColor startrow next intcol)
(setq next (1+ next))
)
)

;;;*************************************************************************
;;; 模块： DSX-Excel-Put-ColumnCellsColor
;;; 描述： 为一列单元格填入颜色
;;; 参数： startrow, startcol, num-rows, color (integer)
;;; 示例： (DSX-Excel-Put-ColumnCellsColor 1 1 5 14) 从行=1、列=1连接5行使用颜色 #14
;;;*************************************************************************

(defun DSX-Excel-Put-ColumnCellsColor (startrow startcol rows intcol / next)
(setq next startrow)
(repeat rows
(DSX-Excel-Put-CellColor next startcol intcol)
(setq next (1+ next))
)
)
;;;*************************************************************************
;;; 模块： DSX-Excel-RangeAutoFit
;;; 描述： 为选中的范围的实行自动调整宽度
;;; 参数： active-sheet (object)
;;; 示例： (DSX-Excel-RangeAutoFit myxlws)
;;;*************************************************************************

(defun DSX-Excel-RangeAutoFit (active-sheet)
(vlax-invoke-method
(vlax-get-property
(vlax-get-property
(vlax-get-property active-sheet 'UsedRange)
'Cells
)
'Columns
)
'AutoFit
)
)


示例 9: 将它们合在一起

让我们将以上代码片段合在一起看看它们是怎样在AutoCAD中发挥作用的。该函数将提示你选择一个Excel.XLS文件打开并获取指定范围的行和列。它将通过列表形式返回数据，每一行为一个列表，而主列表是将每行列表合在一起。就象这样的表达式：( (行列表) (行列表) (行列表) . . .)


(defun C:GETXLREGION
( / xlapp xlfile ready tlbfile ash range xlist)
(cond
( (DSX-Load-TypeLib-Excel)
(cond
( (setq xlfile
(getfiled "Excel电子表格文?quot;
(if G$XFILE G$XFILE "") "XLS" 8
))
(setq G$XFILE xlfile)
(cond
( (setq xlapp (DSX-Open-Excel-Exist xlfile "HIDE"))
(setq ash (msxl-Get-ActiveSheet xlapp))
(setq range (msxl-Get-ActiveCell xlapp))

;;; 从行2列1开始取68行6列的数据出来

(setq xlist (DSX-Excel-GetRangeValues-ByRows 2 1 68 6))

;;; 将每一子列表显示出来看看你拿到了什么样的数据...
(foreach mbr xlist (princ mbr) (terpri))
(setq xlist nil)
(DSX-Excel-Quit xlapp)
(gc); 在关闭Excel后把所有的资源回收!
)
( T (princ "\n开始应用程序进程失败.") )
)
)
)
)
( T (alert "初始化Excel97类型库失败...") )
)
(princ)
)
--------------------------------------------------------------------------------

;;;*************************************************************************
;;; 模块： DSX-Excel-Quit
;;; 描述： 退出并关闭Excel进程
;;; 参数： app (进程对象)
;;; 示例： (DSX-Excel-Quit xlapp)
;;;*************************************************************************

(defun DSX-Excel-Quit (appsession)
(cond
( (not (vlax-object-released-p appsession))
(vlax-invoke-method appsession 'QUIT)
(vlax-release-object appsession)
)
)
)


;;;*************************************************************************
;;; 模块： DSX-Excel-Kill
;;; 描述： 强迫任何打开的Excel进程关闭
;;; 参数： none
;;; 示例： (DSX-Excel-Kill)
;;;*************************************************************************

(defun DSX-Excel-Kill ( / eo)
(while (setq eo (vlax-get-object "Excel.Application"))
(DSX-Excel-Quit eo)
(vlax-release-object eo)
(setq eo nil)
(gc)(gc);; 这样做有时还是不能完全杀除!
)
)


尾声:

尽管本页不能将所有通过AutoCAD使用Excel的方法解释给大家，但它却是一个很好的开始。如果你有任何建议或意见，可以到社区中发表，我们都很乐意听听。

dezhang

谢谢楼主,好久就想好好研究这个东东了,有这个范例就好多了.

yshf

你不是在转贴明经通道总版主的文章嘛，什么建议？
http://mjtd.com/Develop/ArticleShow.asp?ArticleID=667

zhong2013

要收藏:)学习学习……。