鼠标反应器浅谈

yxp

;;CAD提供了双击和右键鼠标反应器，本例对双击事件的回调函数进行测试。
;;供新手阅读，高手请解决一下最后那个内部错误的问题。
;;用法：新建lsp文件，将本帖全部复制后加载，画一个圆，然后双击

(setvar "cmdecho" 0)
;;程序加载时建立鼠标反应器，or 结构可避免重复加载时产生多重回调
(or *ss_Mouse_Reactor* (setq *ss_Mouse_Reactor*
    (vlr-mouse-Reactor nil '((:vlr-beginDoubleClick . DoubleCallback)))))
;;其中 :beginDoubleClick 为鼠标双击事件，DoubleCallback为自定义回调函数名称

;;CAD默认鼠标反应器函数卸载，参数: t 加载，nil 卸载
(defun DBload_unload(s / f x)
  (setq f (if s 'arxload 'arxunload))
  (foreach x '(("acdblclkedit.arx")("acdblclkeditpe.arx"))(vl-catch-all-apply f x))
)

;;鼠标动作-回调函数
(defun DoubleCallback (retr pt / en)
(and (setq *entsel_owen* (nentselp (trans (car pt) 0 1)))
      (setq en (cdr (assoc 0 (entget (car *entsel_owen*))))))
(cond ((= en "CIRCLE")
       (DBload_unload nil) ;;屏蔽CAD双击
;;以下调用lisp函数
;;***方式1: 直接调用，缺点: 被调用函数内的command、entmake、entmode、ssget等无效
;    (print_circle_area)
;;***方式2: 命令行对象，缺点: 会在命令行里显示被调函数名称
;    (vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) "(print_circle_area) ")
;;***方式3: 外部函数，此处调用openDCL函数，需要相关库文件的支持，没有方式1和方式2的缺点
;;例如，飞诗的带关键字和过滤的ssget可以采用此函数屏蔽坐标字符串的回显
      (dcl_SendString "(print_circle_area) ")
      (DBload_unload t) ;;开启CAD双击
      (princ "\n回调函数完成\n")
))
;;由于被调函数内alert的存在，使回调函数先于被调函数结束，
;;说明被调函数和回调函数是异步执行的，有点多线程处理的味道
(princ)
)

;;鼠标动作回调函数的-被调函数
(defun print_circle_area( / dxf r pt a)
(setq dxf (entget(car *entsel_owen*))
      r (cdr (assoc 40 dxf))
      pt (cdr (assoc 10 dxf))
      a (* pi r r))
(alert (strcat "\n圆的半径: " (rtos r 2) "\n圆的面积: " (rtos a 2)))
(command "Line" (getvar "VIEWCTR") pt "")
(princ "\n被调函数完成\n")
(princ)
)

;;另外，多文档模式下，在打开的A、B文档里分别加载本函数运行，
;;当第三次在A文档下运行时，会产生一个内部错误，提示如下:
;; "\n*** INTERNAL ERROR: VL namespace mismatch\n"" type Y to reset: "
;; 2004-2008下均如此，2012则没有报错，有兴趣的话请测试一下。

masterlong

很早就自定义了鼠标双击反应器
每次加载时只能在当前文档起作用
一直在找寻多文档同时启停的解决方法

初步学习了点dwx的应用以后
有一个想法不知有没有可行性
也就是利用DWX切换文档并执行同一命令
从而实现多文档同步启停
最后再返回初始文档

API的帮助文档看得头晕脑胀
完全不知道该从何下手
YXP大侠能不能帮忙诊断下思路是否可行
若可行指点下该从哪里着手

masterlong

自定义鼠标反应器最头疼的地方
是多文档情况下没办法同时启用或停止
实际绘图时文档切换是很频繁的
这个文档启用了另一个文档没启用
操作就会格外不顺畅
不知道楼主解决了这个问题没有？

yxp

masterlong 发表于 2018-5-12 18:28
很早就自定义了鼠标双击反应器
每次加载时只能在当前文档起作用
一直在找寻多文档同时启停的解决方法

反应器要慎用，能不用则尽量不用。

不死猫

读了几句 楼主对Lisp语言的掌握已经比较精湛

wowan1314

读了几句， 没读懂。 楼主已然是大师级的了。

cnks

顶一下！

yxp

调用 (command "DBLCLKEDIT" "OFF") 可以关闭双击编辑，
但是回调函数里是不允许有command存在的。
简化后仍有内部错误的存在

2. (setvar "cmdecho" 0)
   
3. 
   
4. ;;程序加载时建立鼠标反应器，or 结构可避免重复加载时产生多重回调
   
5. (or *ss_Mouse_Reactor* (setq *ss_Mouse_Reactor*
   
6.     (vlr-mouse-Reactor nil '((:vlr-beginDoubleClick . DoubleCallback)))))
   
7. 
   
8. ;;鼠标动作-回调函数
   
9. (defun DoubleCallback (retr pt / en)
   
10. (and  (setq *entsel_owen* (nentselp (trans (car pt) 0 1)))
    
11.       (setq en (cdr (assoc 0 (entget (car *entsel_owen*))))))
    
12. (cond ((= en "CIRCLE")
    
13.        (vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) "(print_circle_area) ")
    
14.         ;(dcl_SendString "(print_circle_area) ")
    
15.        ))
    
16. (princ)
    
17. )
    
18. 
    
19. ;;鼠标动作回调函数的-被调函数
    
20. (defun print_circle_area( / dxf r pt a)
    
21. ;(command "DBLCLKEDIT" "OFF")
    
22. (setq dxf (entget(car *entsel_owen*))
    
23.       r (cdr (assoc 40 dxf))
    
24.      pt (cdr (assoc 10 dxf))
    
25.       a (* pi r r))
    
26. (alert (strcat "\n圆的半径: " (rtos r 2) "\n圆的面积: " (rtos a 2)))
    
27. (command "Line" (getvar "VIEWCTR") pt "")
    
28. (princ "\n被调函数完成")
    
29. ;(command "DBLCLKEDIT" "ON")
    
30. (princ)
    
31. )

(setvar "cmdecho" 0)<br /> <br /> ;;程序加载时建立鼠标反应器，or 结构可避免重复加载时产生多重回调<br /> (or *ss_Mouse_Reactor* (setq *ss_Mouse_Reactor*<br />     (vlr-mouse-Reactor nil '((:vlr-beginDoubleClick . DoubleCallback)))))<br /> <br /> ;;鼠标动作-回调函数<br /> (defun DoubleCallback (retr pt / en)<br /> (and  (setq *entsel_owen* (nentselp (trans (car pt) 0 1)))<br />       (setq en (cdr (assoc 0 (entget (car *entsel_owen*))))))<br /> (cond ((= en "CIRCLE")<br />        (vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) "(print_circle_area) ")<br />         ;(dcl_SendString "(print_circle_area) ")<br />        ))<br /> (princ)<br /> )<br /> <br /> ;;鼠标动作回调函数的-被调函数<br /> (defun print_circle_area( / dxf r pt a)<br /> ;(command "DBLCLKEDIT" "OFF")<br /> (setq dxf (entget(car *entsel_owen*))<br />       r (cdr (assoc 40 dxf))<br />      pt (cdr (assoc 10 dxf))<br />       a (* pi r r))<br /> (alert (strcat "\n圆的半径: " (rtos r 2) "\n圆的面积: " (rtos a 2)))<br /> (command "Line" (getvar "VIEWCTR") pt "")<br /> (princ "\n被调函数完成")<br /> ;(command "DBLCLKEDIT" "ON")<br /> (princ)<br /> )

jyzas

正在学习，支持

danxingpen

(command "DBLCLKEDIT" "OFF") 可以关闭双击编辑?
这个用(setvar "DBLCLKEDIT" 0) 来代替就ok了,关键是你的画线(command "Line" (getvar "VIEWCTR") pt "")

davide888

学习，虽然现在还看不懂   

自贡黄明儒

顶，高手呀。最后那个问题你是怎么解决的？