[原创]：一个与MYIE鼠标操作方式类似的程序框架

lijiao

2. 
   
3.   [FONT=courier new]
   
4. (defun luopan
   
5.        (aa bb / ANGL ANGL0 BIAOJI BLK DIS DIS0 PT PT0 QUYU XYZ)
   
6.   (if (= (getvar "cmdnames") "")
   
7.     (progn
   
8.       (while (not (= 5 (car (setq pt0 (grread t 4 0))))))
   
9.       (setq pt0 (cadr pt0))
   
10.       (setq xyz         (/ (getvar "viewsize") 100.0) ;;;可以修改比例因子100
    
11.             dis0 (* 11.38 xyz) ;;;以修改比例因子11.38
    
12.             quyu 4.0);;;以修改区域份数4
    
13. ;;;      以上三个修改项与罗盘的大小有关
    
14.       (setq angl0 (/ 360.0 quyu))
    
15.       (if (setq blk (caditem nil "blk" "luopan"))
    
16.         (setq blk (vla-InsertBlock
    
17.                     (cadkj nil 0)
    
18.                     (vlax-3d-point pt0)
    
19.                     "luopan"
    
20.                     xyz
    
21.                     xyz
    
22.                     xyz
    
23.                     0.0
    
24.                     ""))
    
25.         (setq blk (vla-InsertBlock
    
26.                     (cadkj nil 0)
    
27.                     (vlax-3d-point pt0)
    
28.                     (findfile ("luopan.dwg");;;文件luopan.dwg要放在搜索路径中，最好用绝对路径
    
29.                     xyz
    
30.                     xyz
    
31.                     xyz
    
32.                     0.0
    
33.                     ""))
    
34.         )
    
35.       (setq biaoji t)
    
36.       (while biaoji
    
37.         (setq pt (grread t 4 0))
    
38.         (cond
    
39.           ((= 3 (car pt))
    
40.            (setq biaoji nil)
    
41.            );;;左键点击为退出
    
42.           ((= 5 (car pt))
    
43.            (setq pt (cadr pt))
    
44.            (setq dis  (distance pt0 pt)
    
45.                  angl (+ 45 (rtod (angle pt0 pt))))
    
46.            (if (> dis dis0)
    
47.              (progn
    
48.                (setq angl (fix (/ angl angl0)))
    
49.                (setq biaoji nil)
    
50.                (cond
    
51.                  ((= angl 0)
    
52.                   (princ angl);;;在第1区域的处理代码
    
53.                   )
    
54.                  ((= angl 1)
    
55.                   (princ angl);;;在第2区域的处理代码
    
56.                   )
    
57.                  ((= angl 2)
    
58.                   (princ angl);;;在第3区域的处理代码
    
59.                   )
    
60.                  ((= angl 3)
    
61.                   (princ angl);;;在第4区域的处理代码
    
62.                   )
    
63.                  ((= angl t)
    
64.                   (princ angl);;;在第1区域的处理代码
    
65.                   )
    
66.                  )
    
67.                )
    
68.              )
    
69.            )
    
70.           )
    
71.         )
    
72.       (vla-delete blk)
    
73.       )
    
74.     )
    
75.   (princ)
    
76.   )
    
77. (if (not cs_mouse)
    
78.   (setq cs_mouse (vlr-mouse-reactor nil '((:vlr-beginRightClick  . luopan))))
    
79.   )
    
80. ;;;其他说明：
    
81. ;;;  1、(caditem nil "blk" "luopan")  返回当前文档中名为LUOPAN的图块，失败为NIL
    
82. ;;;  2、(cadkj nil 0)  返回当前文档的当前操作空间
    
83. ;;;  3、(rtod (angle pt0 pt)) 将弧度转换为角度
    
84. ;;;  以上函数需要自己编写
    
85.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun luopan<br />        (aa bb / ANGL ANGL0 BIAOJI BLK DIS DIS0 PT PT0 QUYU XYZ)<br />   (if (= (getvar "cmdnames") "")<br />     (progn<br />       (while (not (= 5 (car (setq pt0 (grread t 4 0))))))<br />       (setq pt0 (cadr pt0))<br />       (setq xyz         (/ (getvar "viewsize") 100.0) ;;;可以修改比例因子100<br />             dis0 (* 11.38 xyz) ;;;以修改比例因子11.38<br />             quyu 4.0);;;以修改区域份数4<br /> ;;;      以上三个修改项与罗盘的大小有关<br />       (setq angl0 (/ 360.0 quyu))<br />       (if (setq blk (caditem nil "blk" "luopan"))<br />         (setq blk (vla-InsertBlock<br />                     (cadkj nil 0)<br />                     (vlax-3d-point pt0)<br />                     "luopan"<br />                     xyz<br />                     xyz<br />                     xyz<br />                     0.0<br />                     ""))<br />         (setq blk (vla-InsertBlock<br />                     (cadkj nil 0)<br />                     (vlax-3d-point pt0)<br />                     (findfile ("luopan.dwg");;;文件luopan.dwg要放在搜索路径中，最好用绝对路径<br />                     xyz<br />                     xyz<br />                     xyz<br />                     0.0<br />                     ""))<br />         )<br />       (setq biaoji t)<br />       (while biaoji<br />         (setq pt (grread t 4 0))<br />         (cond<br />           ((= 3 (car pt))<br />            (setq biaoji nil)<br />            );;;左键点击为退出<br />           ((= 5 (car pt))<br />            (setq pt (cadr pt))<br />            (setq dis  (distance pt0 pt)<br />                  angl (+ 45 (rtod (angle pt0 pt))))<br />            (if (> dis dis0)<br />              (progn<br />                (setq angl (fix (/ angl angl0)))<br />                (setq biaoji nil)<br />                (cond<br />                  ((= angl 0)<br />                   (princ angl);;;在第1区域的处理代码<br />                   )<br />                  ((= angl 1)<br />                   (princ angl);;;在第2区域的处理代码<br />                   )<br />                  ((= angl 2)<br />                   (princ angl);;;在第3区域的处理代码<br />                   )<br />                  ((= angl 3)<br />                   (princ angl);;;在第4区域的处理代码<br />                   )<br />                  ((= angl t)<br />                   (princ angl);;;在第1区域的处理代码<br />                   )<br />                  )<br />                )<br />              )<br />            )<br />           )<br />         )<br />       (vla-delete blk)<br />       )<br />     )<br />   (princ)<br />   )<br /> (if (not cs_mouse)<br />   (setq cs_mouse (vlr-mouse-reactor nil '((:vlr-beginRightClick  . luopan))))<br />   )<br /> ;;;其他说明：<br /> ;;;  1、(caditem nil "blk" "luopan")  返回当前文档中名为LUOPAN的图块，失败为NIL<br /> ;;;  2、(cadkj nil 0)  返回当前文档的当前操作空间<br /> ;;;  3、(rtod (angle pt0 pt)) 将弧度转换为角度<br /> ;;;  以上函数需要自己编写<br />   [/FONT]<br />

附件中是罗盘文件

lijiao

使用方法：
加载后，不用发命令，在没有活动命令时右击鼠标，出现方向罗盘，然后移动鼠标到相应的区域，就自动执行相应的功能。

wkai

呵呵 和我的编辑易很象呀

lijiao

最初由 wkai 发布
[B]呵呵 和我的编辑易很象呀 [/B]

但我用反应器实现，不用发命令
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
下面是一个实际应用的例子，用来切换菜单。

它山之石

与大家原来点右键时重复上一命令的习惯不符，应该加一个重复命令的功能。

aeo

既然把右键都定义掉了，和右键菜单又有什么区别，就少点一下而已.

sdwy19691229

厉害，第一次见到可以这样，开眼了。