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

mccad · 发表于 2004-11-5 21:33:00

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

copy


(defun C:VBARUNX ()
    (vl-load-com)
    (vla-runmacro
         (vlax-get-acad-object)
         (getstring "\n宏名称: ")
    )
    (princ)
)

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

copy


Function PickFirstSSet() As AcadSelectionSet
    On Error Resume Next
    ThisDrawing.SelectionSets("PICKFIRST").Delete
    Set PickFirstSSet = ThisDrawing.PickfirstSelectionSet
    If PickFirstSSet.Count = 0 Then PickFirstSSet.SelectOnScreen
End Function Sub CC()
    Dim Ent As AcadEntity
    Dim SS As AcadSelectionSet
    Set SS = PickFirstSSet
    For Each Ent In SS
        Ent.color = acGreen
    Next
End Sub

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

copy


;;自动加载VBA程序的函数 
(defun AutoVBALoad (app cmdliste / qapp)
  (vl-load-com)
  (setq qapp (strcat """ app """))
  (mapcar
    '(lambda (cmd / nom_cmd dot nodotcmd)
       (progn
         (setq dot (vl-string-search "." cmd))
         (if dot
           (setq nodotcmd (substr cmd (+ dot 2)))
           (setq nodotcmd cmd)
         )
         (setq nom_cmd (strcat "C:" nodotcmd))
         (eval
           (read (strcat
                   "(defun " nom_cmd "(/ app)"
                     "(if (setq app(fdvbfile " qapp "))"
                       "(vla-runmacro (vlax-get-acad-object) (strcat app "!" cmd ""))"
                       "(nodvbfile " qapp "))"
                   "(princ ))"
       )))))
    cmdliste
  )
  (princ)
) (defun fdvbfile (app)
  (if (not (findfile app))
    (if (not (findfile (strcat app ".dvb"))) nil  (strcat app ".dvb")) app)
) 
(defun nodvbfile (filename)
  (princ (strcat "\n文件 " filename "(.dvb) 在搜索路径文件夹中未找到。" ))
  (princ "\n请检查支持文件的安装，然后重试。")
  (princ)
)

这样刚才那个VBA过程就可以这样加载：复制代码好了，选定一些对象后，输入“CC”看看，是不是很简单。
顺便也给大家介绍一下“先选择后操作”在VBA中是怎样写选择集的，大家可以看到刚才的VBA程序中使用了一个自定义函数：

copy


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

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

mccad · 发表于 2004-11-5 21:57:00

这是以前的讨论链接：

mccad · 发表于 2004-11-6 21:15:00

既然先选择后操作在VBA中可以实现，我们就试一下让VBA程序变成透明命令。呵呵，这个想法在以前想都不敢想。
先试试前面的那个程序，在命令行中输入：
(vlax-add-cmd "cc" 'c:cc "cc" 3)
好了，然后用“'cc”的命令方式调用该VBA程序。不错，可以用了。
再试试在其它命令中调用，看来也没有问题吧。
可以说，我们已经成功了。
既然成功，我们就得想一个简单的方法来让这种实现，还是上面那个AutoVBALoad。就再改一下吧：

copy


;;自动加载VBA程序的函数 
  (vl-load-com)
(defun AutoVBALoad (app cmdliste stat / qapp strcmd)
  (setq qapp (strcat """ app """))
  (mapcar
    '(lambda (cmd / nom_cmd dot nodotcmd)
       (progn
         (setq dot (vl-string-search "." cmd))
         (if dot
           (setq nodotcmd (substr cmd (+ dot 2)))
           (setq nodotcmd cmd)
         )
         (setq nom_cmd (strcat "C:" nodotcmd))
         (if (member stat '(0 1 2 3 4 5 6 7)) 
           (setq strcmd 
                 (strcat"(vlax-add-cmd "" nodotcmd "" \'" 
                        nom_cmd """ nodotcmd """ (itoa stat) " )"))
           (setq strcmd "")
         )
         (eval
           (read (strcat
                   "(defun " nom_cmd "(/ app)"
                     "(if (setq app(fdvbfile " qapp "))"
                       "(progn(vla-runmacro (vlax-get-acad-object) (strcat app "!" cmd ""))"
                       strcmd ")"
                       "(nodvbfile " qapp "))"
                   "(princ ))"
       )))))
    cmdliste
  )
  (princ)
)
(defun fdvbfile (app)
  (if (not (findfile app))
    (if (not (findfile (strcat app ".dvb"))) nil  (strcat app ".dvb")) app)
)
(defun nodvbfile (filename)
  (princ (strcat "\n文件 " filename "(.dvb) 在搜索路径文件夹中未找到。" ))
  (princ "\n请检查支持文件的安装，然后重试。")
  (princ)
)

现在，这个函数增加了一个参数，来让用户选择VBA命令是否生成为AutoCAD命令，或透明命令，或什么都不要，只生成执行命令。
stat参数的含义：0，做为AutoCAD内部命令。1，生成透明命令，还有2,3，4,5，6,7这几种，跟选择方式有关吧，这些的含义可查看vlax-add-cmd函数。除了以上这几种参数外，其它参数均被认为不生成AutoCAD内部命令。
上一贴的命令方法：
复制代码再给大家举个简单的例子吧，把以下程序保存为文件ZZ.DVB文件：

copy


Sub ZP()
    ZoomPrevious
End Sub 
Sub ZA()
    ZoomAll
End Sub
Sub ZE()
    ZoomExtents
End Sub
Sub ZW()
    ZoomPickWindow
End Sub

这是缩放命令的几个快捷方式，使用的是VBA方式实现，我们现在就把它做成透明命令。
(AutoVBALoad "ZZ" '("ZA" "ZP" "ZE" "ZW") 3)
这样，我们就可以在命令期间使用'za,'ze,'zp等来直接缩放窗口了。
[U]到目前为止，我们已经可以让VBA程序与LISP程序一样了。以后，我们就不用为了VBA程序难以调用，不能先选择后操作以及不能透明引用而认为VBA程序有很大的缺陷吧。[/U]

ntchjie · 发表于 2004-11-6 21:47:00

强烈的顶一下，好东西，要打印出来好好看看。

pckite · 发表于 2004-11-15 12:08:00

good!!

miaoph · 发表于 2004-11-16 22:53:00

太棒了

cag · 发表于 2004-11-21 08:42:00

什么叫AX方法？

mccad · 发表于 2004-11-21 09:27:00

ActiveX Automation
如取得圆的半径，用一般的方法：
(setq radius (cdr (assoc 40 (entget circle-entity))))
用ActiveX 函数，就这么简单:
(setq radius (vla-get-radius circle-object))

cag · 发表于 2004-11-21 14:02:00

呵，原来就是ActiveX Automation的简称啊。

tjdxtm · 发表于 2004-11-25 11:45:00

楼主，我用了含有透明命令的AutoVBALoad加载我的vba(在acad2002中)，在第一个drawing中调用没问题，我切换到第二个drawing中就不能调用了，提示什么lisp搭配错误，是什么原因阿？

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

发表回复

精选推荐