[原创]命令行执行VBA程序，先选择后操作，透明命令

 本帖最后由 作者 于 2008-4-29 21:46:22 编辑

一直以来，我们都希望能找到一种简便的方法来实现VBA程序中的先选择后操作。
以前也提供过一种方法，见二次开发栏目的有关PickfirstSelectionSet方法的讨论 文章。
虽然以前提供过方法，但这种方法的缺点是：
1.过程复杂，要写个事件来触发，而且需要写个空的LISP程序来配合，这对一般用户来说有些难度，所以很多开发者最后都放弃使用先选择后操作(呵呵，包括我在内)。
2.这种方法存在BUG，这个BUG本身是AutoCAD的缺陷，而且直到2005都没有解决，看来Autodesk一直就对AX方法不太重视。这个BUG是，当所触发的程序都有对话框，而且对话框需要与AutoCAD交互(如隐藏对话框选择对象或点等操作)，当隐藏对话框后，屏幕中无法操作鼠标，只能使用键盘。
所以因为存在着这样的BUG，我写的那个“对象对齐与均布”的程序也没有使用这个功能(本来象那样的程序就需要可以先选择后操作)。

现在终于找到简单解决的方法，所以与大家分享。
大家都知道，使用LISP函数或AutoCAD命令来调用VBA过程，都会因为触发了其它命令而使PickfirstSelectionSet无法得到刚选定的选择集。但如果使用AX的RunMacro方法，则因为是AX方法，而不影响刚选定选择集的存在。对于VL来说，同样可以调用RunMacro方法，大家可以试试以下的LISP程序：

普通浏览复制代码

1. (defun C:VBARUNX ()
2.     (vl-load-com)
3.     (vla-runmacro
4.          (vlax-get-acad-object)
5.          (getstring "\n宏名称: ")
6.     )
7.     (princ)
8. ) 
9.  
10.  

运行后输入你需要运行的宏(过程)，格式为：DVB文件!模块名.过程名
呵呵，忘了给大家一个样例，将以下的程序保存为CC.DVB文件，注意放到支持目录下，这样就可以先选定图形中的一些对象，然后输入VBARUNX，在出现宏名称提示时输入CC.DVB!CC ，看看图形中的对象是不是变成绿色的。

普通浏览复制代码

1. Function PickFirstSSet() As AcadSelectionSet
2.     On Error Resume Next
3.     ThisDrawing.SelectionSets("PICKFIRST").Delete
4.     Set PickFirstSSet = ThisDrawing.PickfirstSelectionSet
5.     If PickFirstSSet.Count = 0 Then PickFirstSSet.SelectOnScreen
6. End Function 
7.  
8. Sub CC()
9.     Dim Ent As AcadEntity
10.     Dim SS As AcadSelectionSet
11.     Set SS = PickFirstSSet
12.     For Each Ent In SS
13.         Ent.color = acGreen
14.     Next
15. End Sub
16.  
17.  

虽然已经找到了方法，我们就把上一次给大家的一个自动加载及执行VBA程序的函数改一下，变成兼容“先选择后操作”方式：

普通浏览复制代码

1. ;;自动加载VBA程序的函数 
2. (defun AutoVBALoad (app cmdliste / qapp)
3.   (vl-load-com)
4.   (setq qapp (strcat "\"" app "\""))
5.   (mapcar
6.     '(lambda (cmd / nom_cmd dot nodotcmd)
7.        (progn
8.          (setq dot (vl-string-search "." cmd))
9.          (if dot
10.            (setq nodotcmd (substr cmd (+ dot 2)))
11.            (setq nodotcmd cmd)
12.          )
13.          (setq nom_cmd (strcat "C:" nodotcmd))
14.          (eval
15.            (read (strcat
16.                    "(defun " nom_cmd "(/ app)"
17.                      "(if (setq app(fdvbfile " qapp "))"
18.                        "(vla-runmacro (vlax-get-acad-object) (strcat app \"!" cmd "\"))"
19.                        "(nodvbfile " qapp "))"
20.                    "(princ ))"
21.        )))))
22.     cmdliste
23.   )
24.   (princ)
25. ) 
26.  
27. (defun fdvbfile (app)
28.   (if (not (findfile app))
29.     (if (not (findfile (strcat app ".dvb"))) nil  (strcat app ".dvb")) app)
30. ) 
31. (defun nodvbfile (filename)
32.   (princ (strcat "\n文件 " filename "(.dvb) 在搜索路径文件夹中未找到。" ))
33.   (princ "\n请检查支持文件的安装，然后重试。")
34.   (princ)
35. ) 
36.  

这样刚才那个VBA过程就可以这样加载：

1. (AutoVBALoad "CC" '("cc"))

复制代码

好了，选定一些对象后，输入“CC”看看，是不是很简单。

顺便也给大家介绍一下“先选择后操作”在VBA中是怎样写选择集的，大家可以看到刚才的VBA程序中使用了一个自定义函数：

普通浏览复制代码

1. Function PickFirstSSet() As AcadSelectionSet
2.     On Error Resume Next
3.     ThisDrawing.SelectionSets("PICKFIRST").Delete
4.     Set PickFirstSSet = ThisDrawing.PickfirstSelectionSet
5.     If PickFirstSSet.Count = 0 Then PickFirstSSet.SelectOnScreen
6. End Function

这个函数包含了以下的功能：
1.生成选择集。
2.把用户已经选定的对象放在选择集中。
3.如果用户没有选定对象，则提示用户选择对象。
呵呵，就这么几行就可以解决这么多问题，而且还解决了选择集的BUG。这个BUG就不介绍了，论坛中已经介绍过好多次了。

大家在写程序过程中用这个函数来做选择。