VLisp 翻译 Excel Vba 代码的方法

初次看见网上大神们的 VLisp 作品，其中对 Excel 的操作感觉很复杂，先是一大堆 OLB 类型库声明代码，不太懂，然后各种自定义函数，也有点蒙。
幸好，本人 Excel 使用中经常录制和修改宏，对 Excel Vba 还算有一点点的了解。所以，如果你有一点 vba 的基础，本文将对你有一种豁然开朗的感觉。

---

创建 Excel 的 ActiveX 对象

在 AutoCAD 中创建一个 Excel 对象，可能会分别用到以下两句：

(vlax-create-object "Excel.Application")
(vlax-get-or-create-object "Excel.Application")

第1句相当于从 Windows 开始菜单里新打开一个 excel 程序，即创建一个新进程，但是并未显示在任务栏；这种方式速度较慢，大约需要 1-3 秒（固态硬盘、i7处理器、16G内存）。
第2句相当于从 Windows 进程里获取已经打开的 excel 对象，如果没有 Excel 进程则创建，相当于第一句；采用这种方式，如果进程里有 excel 则速度较快。

我们将 excel 对象视为一个 Active/COM 对象，用 VisualLisp 操作对象属性和方法函数，将 vba 代码翻译为 VisualLisp 即可。在 VisualLisp 中对象的属性和方法的操作函数有以下几个，本文演示的功能仅需要 vlax-get-property 和 vlax-put-property 函数。

• vlax-dump-object 查看对象支持的方法和属性
• vlax-get-property 返回对象属性
• vlax-put-property 设置对象属性
• vlax-invoke-method 调用对象的方法
• vlax-property-available-p 查阅对象属性是否可用
• vlax-method-applicable-p 查阅对象方法是否支持

---

访问 Excel 对象模型

不熟悉 Excel Application 对象模型也没关系，可以百度搜索 “Excel Application 对象开发”，或者登陆微软的官方 Excel 对象模型 https://msdn.microsoft.com/ZH-CN/library/ff194068.aspx
本文不建议用 vlax-dump-object 函数查阅 excel 对象的属性与方法，有时候查询会导致 CAD 崩溃，不清楚什么原因，大概是 excel 类库层次太复杂了。

• 用 Vba 对 Excel 的单元格赋值，就是设置 Range 对象的 Cells 属性或 Range 属性的值。

设置 Cells 属性

将当前打开的 Excel 文件的第一个工作表的第一个单元格内容设置为 20，其 vba 完整代码如下：

Application.Workbooks(1).Worksheets(1).Cells(1,1).Value=20

现在，让我们试着一步步将上面的 vba 代码转化为 Vlisp 代码。Lisp 变量命名规则不允许出现句点和括号，把 vba 中 “.”用下划线 “_” 代替，括号用 “[]” 代替。

• A. 返回当前打开的 EXCEL 顶级对象： Application

(setq ExApp (vlax-get-or-create-object "Excel.Application"))

• B. 返回 Application.Workbooks 对象(集合)，带 s 的都是集合，具有 item 属性。

(setq ExApp_wkbs (vlax-get-property ExApp 'Workbooks))

• C. 返回 Application.Workbooks(1) 对象，相当于 Application.Workbooks(1)

(setq ExApp_wkbs[1] (vlax-get-property ExApp_wkbs 'item 1))

• 注意：当新建一个 excel 进程时，如果当前工作表是空的（Count 属性为 0），这步将会出错。可以用以下语句检查一下，如果为 0 ，则需要新建一个工作表。

  (vlax-get-property ExApp_wkbs ‘count)

  或者直接让 excel 对象显示出来，看看 Excel 工作表是不是空的：

  (vlax-put-property ExApp ‘Visible 1)

• D. 返回 Application.Workbooks(1).Worksheets 对象(集合)

(setq ExApp_wkbs[1]_wkss (vlax-get-property ExApp_wkbs[1] 'Worksheets))

• E. 返回 Application.Workbooks(1).Worksheets(1) 对象

(setq ExApp_wkbs[1]_wkss[1] (vlax-get-property ExApp_wkbs[1]_wkss 'item 1))

• F. 返回 Application.Workbooks(1).Worksheets(1).Cells 对象(集合)

(setq ExApp_wkbs[1]_wkss[1]_Cell (vlax-get-property ExApp_wkbs[1]_wkss[1] 'Cells))

• G. 设置 Cells(1,1) 单元格 A1 为 20，成功则返回 nil

(vlax-put-property ExApp_wkbs[1]_wkss[1]_Cell 'item 1 1 20)

设置 Range 属性

有了上述 A-G 步骤，可以照葫芦画瓢，设置 Range(“B1”) 的属性为 25，vba 代码如下：

Application.Workbooks(1).Worksheets(1).Range("A1").Value=25

前面 A-E 相同，从第 F 步翻译如下：

• F2. 返回 Application.Workbooks(1).Worksheets(1).Range(“B1”) 对象

(setq ExApp_wkbs[1]_wkss[1]_Range (vlax-get-property ExApp_wkbs[1]_wkss[1] 'Range "B1"))

• G2. 给 “B1” 单元格赋值

(vlax-put-property ExApp_wkbs[1]_wkss[1]_Range 'value2 25)

尚不明白为什么是 value2 属性，用 value 属性赋值会失败，在 vba 里却没问题。
上面用 VLisp 函数获取对象属性显得十分啰嗦，相同的功能一句 vba 需要翻译为 7 句 VLisp，完全可以自定义一个 Lisp 函数，按“.”分割对象的属性，再逐一分析属性值后括号里的数字。节省一层层的 VLisp 函数调用，这样的函数也有现成的。但是，本人要说的是，这样做也会各有利弊，那就是代码的运行效率。
比如，要对某个单元格赋值，需要调用 4 层属性，最后一层是 .Value 属性。如果是在循环 1 千次单元格赋值，就需要解析调用 4 千次对象属性。采用笨办法的好处是，我们只控制最后一层 Range 对象变量，这样只需要 循环 1 千次的属性调用，实测赋值速度大约能快 2-3 倍。
由于 Range 对象本身的限制，大批单元格赋值时速度仍然很慢，10 万个单元格赋值大约需要运行几十秒，这时就要用到数组的概念，数秒即可完成，方法如下：

---

单元格批量赋值

前面演示了两种对单元格赋值的方法。我们知道在 vba 中，如果有大量的单元格数据需要填充时，例如 5 万个单元格赋值，这时无论用 cells 还是 range 属性，一个一个单元格的赋值速度是很慢的，一般通过设置单元格的 resize 属性，将 Range 对象扩充，再导入数组即可，在 Vba 中表示如下：

Range("A1").Resize(2,5)=[{1,2,3,4,5;2,4,6,8,10}]

Resize 扩充的行列参数，可以通过数组计算出来，Resize(2,5) 为扩充 2 行 5 列。另外，在 vba 中，如果是操作当前工作表，一般可以不写前缀 Application.Workbooks(n).Worksheets(n)，编译的时候 VBA 编辑器会自动添加，但是在 vlisp 中需要一层一层的引用对象，所以无法省略。同时，需要将 Lisp 表转为数组，数组只能是一维或二维。

;;Excel 单元格批量赋值  by  yxp
(defun c:test()
(setq ExApp (vlax-get-or-create-object "Excel.Application"))
(setq ExApp_wkbs (vlax-get-property ExApp 'Workbooks))
(setq ExApp_wkbs[1] (vlax-get-property ExApp_wkbs 'item 1))
(setq ExApp_wkbs[1]_wkss (vlax-get-property ExApp_wkbs[1] 'Worksheets))
(setq ExApp_wkbs[1]_wkss[1] (vlax-get-property ExApp_wkbs[1]_wkss 'item 1))
(setq ExApp_wkbs[1]_wkss[1]_Range (vlax-get-property ExApp_wkbs[1]_wkss[1] 'Range "A1"))
;;将 A1 单元格扩充为 2 行 5 列的数组对象
(setq xResize (vlax-get-property ExApp_wkbs[1]_wkss[1]_Range 'Resize 2 5))
;;定义一个 2 维数组，数组上限为 5
(setq Arr (vlax-make-safearray 12 '(1 . 2) '(1 . 5)))
;;将 List 表填充到数组中
(vlax-safearray-fill Arr '((1 2 3 4 5)(2 4 6 8 10)))
;;Vlisp 数组对 Excel 数组对象赋值
(vlax-put-property xResize 'value2 Arr)
)

将上面代码复制粘贴到CAD命令行，就可将 list 表 ((1 2 3 4 5)(2 4 6 8 10)) 导出到 excel 里。
是不是很简单 ^_^，打通了 Vba 和 Vlisp 的任督二脉，你现在可以将 vba 里的各种技巧搬到 Vlisp 里来了。

示例

下面一个示例，用 CELLS 属性演示了将 CAD 块属性定义导出到 excel 的功能：

;;提取属性块到 excel   by   yxp   2017-5-24
(vl-load-com)
(defun c:test( / ss en n LL AA)
(setq ss (ssget '((0 . "INSERT"))) n 0)
(if ss (repeat (sslength ss)
    (setq en (ssname ss n) n (1+ n) LL (Get_Attrib en))
    (if LL (setq AA (cons (cons (itoa n) LL) AA)))
))(List2excel (cons '("编号" "标记" "值" "标记" "值") (reverse AA)) "a")
(princ)
)
;;提取 CAD 属性
(defun Get_Attrib (ed / o l)
(setq o (vlax-Ename->vla-Object ed))
(if (= (vla-Get-HasAttributes o) ':vlax-true)
    (mapcar '(lambda(x)(setq l (vl-list* (vla-Get-TagString x)(vla-Get-TextString x) l)))
        (vlax-safearray->list (vlax-variant-value (vla-GetAttributes o))))
)l
)
;;导出 L 表到 excel, p="a" 时，为追加模式
(defun List2excel(L p / S I G W A E r c k d)
(setq S vlax-get-property I vlax-invoke
    G (vlax-get-or-create-object "Excel.Application")
    W (S G 'Workbooks)
    A (S(S(if(=(S W 'count) 0)(I W 'add)(S W 'item 1))'Worksheets)'item 1)
    E (S A 'Cells) r 0 c 0 k 0)
(if (= "a" p)(setq Z (S A 'UsedRange) k (S(I Z 'SpecialCells 11) 'row)))
(repeat (length L)
    (setq d (nth r L) r (1+ r))
    (repeat (length d)
        (vlax-put-property E 'item (+ k r)(1+ c)(vl-princ-to-string (nth c d)))
        (setq c (1+ c))
    )(setq c 0)
)(vla-put-Visible G 1)
)