[分享]AutoVBALoad函数改进
;自动加载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 "(AddCommandsInMDI \""
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)
)其中vlax-add-cmd 改成了 AddCommandsInMDI 需要配合下面两个函数：(defun AddCommandsHelper (CallingReactor CommandList / return ok)
(foreach x *AddCommandsList*
(if (and (member (type (eval (caddr x))) '(SUBR USUBR EXRXSUBR))
(setq ok (apply 'vlax-add-cmd (cdr x)))
)
(setq return (cons ok return))
)
)
return
)
(defun AddCommandsInMDI (lst / old)
(foreach x lst
(vlax-remove-cmd (car x))
(if (setq old (assoc (strcase (car x)) *AddCommandsList*))
(setq *AddCommandsList*
(subst (cons (strcase (car x)) x)
old
*AddCommandsList*
)
)
(setq *AddCommandsList*
(cons (cons (strcase (car x)) x)
*AddCommandsList*
)
)
)
)
(if (not InitializeAddCommandsReactor)
(setq InitializeAddCommandsReactor
(vlr-docmanager-reactor
"InitializeAddCommands"
'((:vlr-documentBecameCurrent . AddCommandsHelper))
)
)
)
(AddCommandsHelper NIL NIL)
)
这样就可以避免两个文档用一个命令调用VBA程序的错误了，这个方法是网上搜索来的。我学校里学的是VB，毕业自己看VBA的书，LISP是一窍不通，多亏网络的强大啊。这个bug老早就有人提过了，那个至顶的帖子几年了居然还没有解决方案，明经是不是没落了？
页:
[1]