乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 133|回复: 9

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

[复制链接]

158

主题

2315

帖子

10

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2951
发表于 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程序:
  1. (defun C:VBARUNX ()
  2.     (vl-load-com)
  3.     (vla-runmacro
  4.          (vlax-get-acad-object)
  5.          (getstring "\n宏名称: ")
  6.     )
  7.     (princ)
  8. )
运行后输入你需要运行的宏(过程),格式为: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 Sub CC()
  7.     Dim Ent As AcadEntity
  8.     Dim SS As AcadSelectionSet
  9.     Set SS = PickFirstSSet
  10.     For Each Ent In SS
  11.         Ent.color = acGreen
  12.     Next
  13. End Sub
虽然已经找到了方法,我们就把上一次给大家的一个自动加载及执行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. ) (defun fdvbfile (app)
  26.   (if (not (findfile app))
  27.     (if (not (findfile (strcat app ".dvb"))) nil  (strcat app ".dvb")) app)
  28. )
  29. (defun nodvbfile (filename)
  30.   (princ (strcat "\n文件 " filename "(.dvb) 在搜索路径文件夹中未找到。" ))
  31.   (princ "\n请检查支持文件的安装,然后重试。")
  32.   (princ)
  33. )
这样刚才那个VBA过程就可以这样加载:复制代码好了,选定一些对象后,输入“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就不介绍了,论坛中已经介绍过好多次了。
大家在写程序过程中用这个函数来做选择。
回复

使用道具 举报

158

主题

2315

帖子

10

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2951
发表于 2004-11-5 21:57:00 | 显示全部楼层
这是以前的讨论链接:
回复

使用道具 举报

158

主题

2315

帖子

10

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2951
发表于 2004-11-6 21:15:00 | 显示全部楼层

既然先选择后操作在VBA中可以实现,我们就试一下让VBA程序变成透明命令。呵呵,这个想法在以前想都不敢想。
先试试前面的那个程序,在命令行中输入:
(vlax-add-cmd "cc" 'c:cc "cc" 3)
好了,然后用“'cc”的命令方式调用该VBA程序。不错,可以用了。
再试试在其它命令中调用,看来也没有问题吧。
可以说,我们已经成功了。
既然成功,我们就得想一个简单的方法来让这种实现,还是上面那个AutoVBALoad。就再改一下吧:
  1. ;;自动加载VBA程序的函数
  2.   (vl-load-com)
  3. (defun AutoVBALoad (app cmdliste stat / qapp strcmd)
  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.          (if (member stat '(0 1 2 3 4 5 6 7))
  15.            (setq strcmd
  16.                  (strcat"(vlax-add-cmd "" nodotcmd "" \'"
  17.                         nom_cmd """ nodotcmd """ (itoa stat) " )"))
  18.            (setq strcmd "")
  19.          )
  20.          (eval
  21.            (read (strcat
  22.                    "(defun " nom_cmd "(/ app)"
  23.                      "(if (setq app(fdvbfile " qapp "))"
  24.                        "(progn(vla-runmacro (vlax-get-acad-object) (strcat app "!" cmd ""))"
  25.                        strcmd ")"
  26.                        "(nodvbfile " qapp "))"
  27.                    "(princ ))"
  28.        )))))
  29.     cmdliste
  30.   )
  31.   (princ)
  32. )
  33. (defun fdvbfile (app)
  34.   (if (not (findfile app))
  35.     (if (not (findfile (strcat app ".dvb"))) nil  (strcat app ".dvb")) app)
  36. )
  37. (defun nodvbfile (filename)
  38.   (princ (strcat "\n文件 " filename "(.dvb) 在搜索路径文件夹中未找到。" ))
  39.   (princ "\n请检查支持文件的安装,然后重试。")
  40.   (princ)
  41. )
现在,这个函数增加了一个参数,来让用户选择VBA命令是否生成为AutoCAD命令,或透明命令,或什么都不要,只生成执行命令。
stat参数的含义:0,做为AutoCAD内部命令。1,生成透明命令,还有2,3,4,5,6,7这几种,跟选择方式有关吧,这些的含义可查看vlax-add-cmd函数。除了以上这几种参数外,其它参数均被认为不生成AutoCAD内部命令。
上一贴的命令方法:
复制代码再给大家举个简单的例子吧,把以下程序保存为文件ZZ.DVB文件:
  1. Sub ZP()
  2.     ZoomPrevious
  3. End Sub
  4. Sub ZA()
  5.     ZoomAll
  6. End Sub
  7. Sub ZE()
  8.     ZoomExtents
  9. End Sub
  10. Sub ZW()
  11.     ZoomPickWindow
  12. End Sub
这是缩放命令的几个快捷方式,使用的是VBA方式实现,我们现在就把它做成透明命令。
(AutoVBALoad "ZZ" '("ZA" "ZP" "ZE" "ZW") 3)
这样,我们就可以在命令期间使用'za,'ze,'zp等来直接缩放窗口了。
[U]到目前为止,我们已经可以让VBA程序与LISP程序一样了。以后,我们就不用为了VBA程序难以调用,不能先选择后操作以及不能透明引用而认为VBA程序有很大的缺陷吧。[/U]
回复

使用道具 举报

12

主题

68

帖子

6

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
116
发表于 2004-11-6 21:47:00 | 显示全部楼层
强烈的顶一下,好东西,要打印出来好好看看。
回复

使用道具 举报

22

主题

54

帖子

4

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
142
发表于 2004-11-15 12:08:00 | 显示全部楼层
good!!
回复

使用道具 举报

12

主题

27

帖子

1

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
75
发表于 2004-11-16 22:53:00 | 显示全部楼层
太棒了
回复

使用道具 举报

cag

87

主题

265

帖子

10

银币

中流砥柱

Rank: 25

铜币
613
发表于 2004-11-21 08:42:00 | 显示全部楼层
什么叫AX方法?
回复

使用道具 举报

158

主题

2315

帖子

10

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2951
发表于 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

87

主题

265

帖子

10

银币

中流砥柱

Rank: 25

铜币
613
发表于 2004-11-21 14:02:00 | 显示全部楼层
呵,原来就是ActiveX Automation的简称啊。
回复

使用道具 举报

12

主题

38

帖子

4

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
86
发表于 2004-11-25 11:45:00 | 显示全部楼层
楼主,我用了含有透明命令的AutoVBALoad加载我的vba(在acad2002中),在第一个drawing中调用没问题,我切换到第二个drawing中就不能调用了,提示什么lisp搭配错误,是什么原因阿?
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-16 15:00 , Processed in 0.329161 second(s), 72 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表