[推荐]：关于反应器使用的很好例子

eachy · 发表于 2004-8-5 06:48:39

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

http://www.xdcad.net/forum/showthread.php?s=&threadid=218672

搜索到一个例子

(if (not myreactor1)
(setq MyReactor1
(vlr-dwg-reactor
nil
'((:vlr-BeginSave . DoThisBeforeSave)
(:vlr-SaveComplete . DoThisAfterSave)
)
)
)
)
(defun DoThisAfterSave (Caller CmdSet)
(alert "You just saved the drawing!")
(princ)
)
(defun DoThisBeforeSave (Caller CmdSet)
(alert "You are about to save the drawing!")
(princ)
)
(defun Clear_My_Reactors ()
(if (and MyReactor1
(vlr-added-p MyReactor1)
)
(vlr-remove MyReactor1)
)
)
(defun Clear_All_Reactors (/ TMP)
(vlr-remove-all :vlr-dwg-reactor)
)

[iframe h=600]http://cadence.advanstar.com/newsletter/cad_manager/0602_2.html[/iframe]

CAD的反应器类型：

1  Vlr-acdb-reactor
  AutoCAD 数据库反应器在从图形数据库中加入、修改或删除对象时通知应用程序。

2 vlr-command-reactor
AutoCAD 命令反应器，对命令事件给出通知。

3 vlr-docmanager-reactor
文档反应器，通知与图形文档相关的事件

4 vlr-dwg-reactor
图形反应器，通知图形事件（如打开或关闭图形文件）

5 vlr-dxf-reactor
DXF编辑器反应器，通知与读写 DXF 文件相关的事件

6 vlr-editor-reactor
  编辑器反应器

7 vlr-linker-reactor
ARX链接应器，在每次应用程序加载或卸载 ObjectARX 应用程序时通知应用程序

8 vlr-lisp-reactor
LISP事件反应器，通知 LISP 事件

9 vlr-xref-reactor
Xref 事件反应器，在发生贴附或修改外部参照事件时通知应用程序。

10  vlr-window-reactor
窗口反应器，在发生与移动或缩放 AutoCAD 窗口相关的事件时通知应用程序。

11 vlr-wblock-reactor
Wblock反应器，在发生与写块相关的事件时通知应用程序。

12  vlr-undo-reactor
Undo反应器，构造通知放弃操作的编辑器反应器。

13 vlr-toolbar-reactor
Toolbar反应器，在工具栏中的位图改变时通知应用程序。

14  vlr-sysvar-reactor
系统变量反应器，在修改系统变量时通知应用程序

15 Vlr-object-reactor
Object反应器，对象操作时通知应用程序

16 vlr-mouse-reactor
Mouse反应器，通知鼠标事件（如双击）

17 vlr-miscellaneous-reactor
miscellaneous反应器，不属于任何其他编辑器反应器类型。

18 vlr-insert-reactor
  通知与块插入相关的事件。

　

eachy · 发表于 2004-8-5 07:21:59

Lockdwg 的原理是利用反应器禁止对图形操作，并没有采用禁止命令的方式，只不过在执行非授权操作前先 erase 所有实体。

比如将上面的 DoThisAfterSave 函数换成下面的形式

(defun DoThisAfterSave (Caller CmdSet)
(vlax-map-collection
(vlax-get-property
(vlax-get-property (vlax-get-acad-object) 'activedocumment)
'modelspace
)
'(lambda (x) (vla-delete x))
)
(princ)
)

netbee · 发表于 2004-8-5 10:56:42

反应器是Vlisp中一个强大的功能，有了它你可以编辑出很多方便的编辑功能！
比如我们常用的坐标标注，要是用了反应器，每一个坐标标注后，可以在移动坐标标注线的标注点处的顶点时，即时更新标注坐标值，而在移动坐标标注线的文字端的顶点时，可以同时移动文字，及标注线。总之，可以做得和系统的标注一样的即时性，方便性了。这个思路，大家共同来看看！

eachy · 发表于 2004-8-5 11:56:01

上午花了很长时间看反应器部分，一点成果。
先研究反应器部分，加密与还原部分有兴趣请各抒己见。

[B]注意：Lisp 不熟悉者切勿在绘图时加载本程序，切记！！[/B]

;;设定自动保存时间，10个小时最大值了
(setvar "savetime" 600)
(setvar "pickfirst" 0)
;(command ".undo" "a" "off")
;(command ".undo" "c" "n")
;;对2000以上，先关闭后设置
(if (not *myDoc*)
(setq
*myDoc* (vlax-get-property (vlax-get-acad-object) 'activedocument)
)
)
;;禁止保存
(if (not myDWGReactor)
(setq myDWGReactor
(vlr-dwg-reactor
nil
'((:vlr-beginsave . DelAllObject))
)
)
)
;;Lisp反应器
(if (not myLispReactor)
(setq myLispReactor
(vlr-lisp-reactor
nil
'((:vlr-lispWillStart . DelAllObject))
)
)
)
;;系统变量反应器
(if (not mySysvarReactor)
(setq mySysVarReactor
(vlr-sysvar-reactor
nil
'((:vlr-sysvarchanged . myResetSysvar))
)
)
)
;;这里可以禁止使用的命令
(if (not myCommandReactor)
(setq myCommandReactor
(vlr-command-reactor
nil
'((:vlr-commandwillstart . myTestCommand))
)
)
)
(if (not myWblockReactor)
(setq myWblockReactor
(vlr-wblock-reactor
nil
'((:VLR-wblockNotice . DelAllObject))
)
)
)
;;设置自动保存时间
(defun myResetSysvar (var1 var2)
;;(princ var2)
(cond
((/= (getvar "savetime") 600)
(setvar "savetime" 600)
)
((/= (getvar "pickfirst") 0)
(setvar "pickfirst" 0)
)
(t)
)
)
;;提示可以自己定制了
(defun myAlert ()
(alert "\n★★ 版权所有 ★★")
(princ)
)
;;删除当前所有实体
(defun e:DelALL ()
(vlax-map-collection
(vlax-get-property *myDoc* 'modelspace)
'(lambda (x)
(vla-delete x)
)
)
)
;;反应器回调函数
(defun DelAllObject (var1 var2)
(e:delall)
(myAlert)
(princ)
)
;;禁止运行的命令
(defun myTestCommand (var1 var2)
;(princ var2)
;(princ var1)
(if (Wcmatch (strcase (vl-princ-to-string (car date))) "*NEW")
(progn
(e:delall)
(myalert)
)
(princ)
)

;;设定自动保存时间，10个小时最大值了 
(setvar "savetime" 600) 
(setvar "pickfirst" 0) 
;(command ".undo" "a" "off") 
;(command ".undo" "c" "n") 
;;对2000以上，先关闭后设置 
(if (not *myDoc*) 
  (setq 
    *myDoc* (vlax-get-property (vlax-get-acad-object) 'activedocument) 
  ) 
) 
;;禁止保存 
(if (not myDWGReactor) 
  (setq        myDWGReactor 
         (vlr-dwg-reactor 
           nil 
           '((:vlr-beginsave . DelAllObject)) 
         ) 
  ) 
) 
;;Lisp反应器 
(if (not myLispReactor) 
  (setq        myLispReactor 
         (vlr-lisp-reactor 
           nil 
           '((:vlr-lispWillStart . DelAllObject)) 
         ) 
  ) 
) 
;;系统变量反应器 
(if (not mySysvarReactor) 
  (setq        mySysVarReactor 
         (vlr-sysvar-reactor 
           nil 
           '((:vlr-sysvarchanged . myResetSysvar)) 
         ) 
  ) 
) 
;;这里可以禁止使用的命令 
(if (not myCommandReactor) 
  (setq        myCommandReactor 
         (vlr-command-reactor 
           nil 
           '((:vlr-commandwillstart . myTestCommand)) 
         ) 
  ) 
) 
(if (not myWblockReactor) 
  (setq        myWblockReactor 
         (vlr-wblock-reactor 
           nil 
           '((:VLR-wblockNotice . DelAllObject)) 
         ) 
  ) 
) 
;;设置自动保存时间 
(defun myResetSysvar (var1 var2) 
  ;;(princ var2) 
  (cond 
    ((/= (getvar "savetime") 600) 
     (setvar "savetime" 600) 
    ) 
    ((/= (getvar "pickfirst") 0) 
     (setvar "pickfirst" 0) 
    ) 
    (t) 
  ) 
) 
;;提示可以自己定制了 
(defun myAlert () 
  (alert "\n★★ 版  权  所  有 ★★") 
  (princ) 
) 
;;删除当前所有实体 
(defun e:DelALL        () 
  (vlax-map-collection 
    (vlax-get-property *myDoc* 'modelspace) 
    '(lambda (x) 
       (vla-delete x) 
     ) 
  ) 
) 
;;反应器回调函数 
(defun DelAllObject (var1 var2) 
  (e:delall) 
  (myAlert) 
  (princ) 
) 
;;禁止运行的命令 
(defun myTestCommand (var1 var2) 
  ;(princ var2) 
  ;(princ var1) 
  (if (Wcmatch (strcase (vl-princ-to-string (car date))) "*NEW") 
    (progn 
      (e:delall) 
      (myalert) 
  ) 
  (princ) 
)

LUCAS · 发表于 2004-8-5 13:00:18

重點是如何騙他加載程序!
加密与还原才是重頭戲!

eachy · 发表于 2004-8-5 13:12:23

CAD有几个文件是一定加载的，2000+以上是 acad200xdoc.lsp ，acad.lsp 是可以用变量控制的。如果将 acad200xdoc.lsp 编译为 vlx 和DWG一个目录下是肯定加载的。
在vlx文件中就保存了还原部分。

当然这种Vlr反应器目前已发现的就有几个不理想的地方，测试中。作为一种技术还是值得探讨的。

LUCAS · 发表于 2004-8-5 13:29:32

不理想的地方
1.想方法禁用vlr-remove-all
2.myAlert觸發了兩次(避免觸發成回圈)
3.每個回調函數要有(vl-load-com)
4.回調函數只能用activeX (SETVAR最好不要用)

eachy · 发表于 2004-8-5 13:47:09

最初由 LUCAS 发布
[B]不理想的地方
1.想方法禁用vlr-remove-all
2.myAlert觸發了兩次(避免觸發成回圈)
3.每個回調函數要有(vl-load-com)
4.回調函數只能用activeX (SETVAR最好不要用) [/B]

1 行不通的，vlx 编译后在自己的 namespace ，是无法 list 和 remove 的

Free-Lancer · 发表于 2004-8-6 06:55:10

最初由 eachy 发布
[B]上午花了很长时间看反应器部分，一点成果。
先研究反应器部分，加密与还原部分有兴趣请各抒己见。

[B]注意：Lisp 不熟悉者切勿在绘图时加载本程序，切记！！[/B]

[code]
;;设定自动保存?... [/B]

反应器写的太多，其实一个就够了 EditorReactor，斑竹可以查看联机帮助除了Wblock其他的都包括在内。

lgb711010 · 发表于 2014-5-21 21:06:39

努力学习，提高能力，多谢版主！

账号		自动登录	找回密码
密码			立即注册

[推荐]：关于反应器使用的很好例子

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子