#!lisp
;;; 双击反应器 2007-11-19
;;; http://www.ViTarn.com/
;;; 命令: (>DoubleClickAttach (car (entsel)) T)
(defun >DoubleClickDefine ()
    (vl-load-com)
    ; 建立反应器对象
    (or
        *MY_Mouse_Reactor*
        (setq *MY_Mouse_Reactor* (vlr-mouse-Reactor "MY_Mouse" '((:vlr-beginDoubleClick . >DoubleClickCallback))))
    )
    ; 尝试加载/卸载ARX
    (vl-catch-all-apply 'arxunload '("acdblclkedit.arx"))
    (vl-catch-all-apply 'arxload '("acdblclkedit.arx"))
    ; 定义双击回调函数
    (defun >DoubleClickCallback (reactor point / selp point ent)
        ; 双击时的坐标 转化到当前坐标系
        (setq point (trans (car point) 0 1))
        (if (setq selp (nentselp point))
            (progn
                ; 如果是块 取块的图元名
                (if (> (length selp) 2)
                    (setq ent (last (last selp)))
                    (setq ent (car selp))
                )
                ; 是否自定义双击 取决于ldata中的"DoubleClick"
                (if (vlax-ldata-get ent "DoubleClick")
                    (progn
                        ; 令系统自带的双击功能失效
                        (vl-catch-all-apply 'arxunload '("acdblclkedit.arx"))
                        ; 取消选取的对象 这是令双击失效的关键
                        (sssetfirst nil)
                        ; 自定义处理
                        (>DoubleClickExecute ent point)
                        ; 恢复系统自带的双击功能
                        (vl-catch-all-apply 'arxload '("acdblclkedit.arx"))
                    )
                )
            )
        )
    )
)
;;; 双击反应器自动加载
(or
    *MY_Mouse_Reactor*
    (>DoubleClickDefine)
)
;;; 双击事件自定义处理函数
(defun >DoubleClickExecute (ent point)
    (prompt (strcat (VL-PRINC-TO-STRING ent) " " (VL-PRINC-TO-STRING point) "\n"))
)
;;; 清除图形中的全部双击反应器
(defun >DoubleClickClearAll (/ ss i e)
    (setq *MY_Mouse_Reactor* nil)
    (setq ss (ssget "x"))
    (setq i 0)
    (repeat (sslength ss)
        (vlax-ldata-delete (ssname ss i) "DoubleClick")
        (setq i (1+ i))
    )
)
;;; 绑定图元双击反应器
(defun >DoubleClickAttach (ent on)
    (if on
        (vlax-ldata-put ent "DoubleClick" T)
        (vlax-ldata-delete ent "DoubleClick")
    )
)