【抛砖引玉】关于右键菜单，另类实现工具面板

x_s_s_1

文章较长，且逻辑性不强，没兴趣请跳过
对于可能长时间处于一个固定状态的制图工作，一个大面板可能效率不高。我针对于自己的实际需要，采用了右键菜单，模拟小面板。这样做的好处在于1.提高效率；2.可以用快捷键，经常打游戏的asdfqwe用得比较溜的，可以试试。效果如下:

本人水平有限，对于mnu文件和popupmenu对象一知半解，希望各位网友指正。
思路是这样的
1.准备ini文件，通过读ini文件，修改菜单；（这里可以改成读excel，方便修改，我对这方面不熟，用的读txt文件）
文件格式为
"模态标签","模态名称"
"快捷键","命令提示","命令"
下面是ini文件片段

1. MODE1,转换出图
   
2. 1,计算导入,AAJSSDRGL
   
3. a,图纸转换,XTY-CMD-YJK
   
4. MODE2,基础绘制
   
5. a,范围选数,XTY-CMD-FWXS
   
6. s,墙柱填充,XTY-CMD-HATCH
   
7. d,承台桩定位,AACTZDWBZ
   
8. 。。。
   

MODE1,转换出图<br /> 1,计算导入,AAJSSDRGL<br /> a,图纸转换,XTY-CMD-YJK<br /> MODE2,基础绘制<br /> a,范围选数,XTY-CMD-FWXS<br /> s,墙柱填充,XTY-CMD-HATCH<br /> d,承台桩定位,AACTZDWBZ<br /> 。。。<br />

2.读取ini文件（我用的文件名为XTDI-COMMAND.INI，把他放到支持文件夹），形成表；

1. (defun xty-mnu-getini (/ F FILE LST LST1 TXT temp)
   
2.   (setq  file (findfile "XTDI-COMMAND.INI")
   
3.   f    (open file "r")
   
4.   lst  '() ;_准备总表
   
5.   lst1 '() ;_准备分表
   
6.   )
   
7.   (while (setq txt (read-line f)) ;_读每行
   
8.     (if  (wcmatch txt "MODE*") ;_当为mode
   
9.       (setq lst   (if lst1
   
10.        (cons (reverse lst1) lst)
    
11.      ) ;_当分表不空，倒置分表组总表
    
12.       lst1 (list(xty-str-tolstby txt ",")) ;_mode放入分表
    
13.       )
    
14.       (setq temp (xty-str-tolstby txt ",")
    
15.       temp (list(strcat (car temp)"."(cadr temp))(strcat (caddr temp)" "))
    
16.       lst1 (cons temp lst1)
    
17.       ) ;_非mode放入分表
    
18.     )
    
19.   )
    
20.   (close f)
    
21.   (setq  lst (cons (reverse lst1) lst) ;_最后一个分表要倒置组入总表
    
22.   lst (reverse lst) ;_倒置总表
    
23.   )
    
24. )

(defun xty-mnu-getini (/ F FILE LST LST1 TXT temp)<br />   (setq  file (findfile "XTDI-COMMAND.INI")<br />   f    (open file "r")<br />   lst  '() ;_准备总表<br />   lst1 '() ;_准备分表<br />   )<br />   (while (setq txt (read-line f)) ;_读每行<br />     (if  (wcmatch txt "MODE*") ;_当为mode<br />       (setq lst   (if lst1<br />        (cons (reverse lst1) lst)<br />      ) ;_当分表不空，倒置分表组总表<br />       lst1 (list(xty-str-tolstby txt ",")) ;_mode放入分表<br />       )<br />       (setq temp (xty-str-tolstby txt ",")<br />       temp (list(strcat (car temp)"."(cadr temp))(strcat (caddr temp)" "))<br />       lst1 (cons temp lst1)<br />       ) ;_非mode放入分表<br />     )<br />   )<br />   (close f)<br />   (setq  lst (cons (reverse lst1) lst) ;_最后一个分表要倒置组入总表<br />   lst (reverse lst) ;_倒置总表<br />   )<br /> )

3.替换AutoCAD的默认右键菜单项，我用的是autocad2020中文版，默认菜单的名称为"默认菜单"；

1. ;;;=============================================
   
2. ;;;      通用函数  替换菜单全部项
   
3. ;;;参数： mnugname--------要修改的菜单组名
   
4. ;;;       mnuname---------要修改的菜单名
   
5. ;;;       itemlst-----要修改的菜单项表
   
6. ;;;返回值：修改的菜单对象
   
7. ;;;示例xty-mnu-changepop "acad" "默认菜单" '(("a.l""line ")))
   
8. (defun xty-mnu-changepop  (mnugname mnuname itemlst / mnug mnus pop stct i)
   
9.   (setq  mnug (vl-catch-all-apply
   
10.          'vlax-invoke-method
    
11.          (list *xty-mnugs* 'item mnugname)
    
12.        ) ;_菜单组是否存在
    
13.   )
    
14.   (if (null (vl-catch-all-error-p mnug)) ;_如果存在要搜索菜单组
    
15.     (progn
    
16.       (setq mnus (vlax-get-property mnug 'menus)) ;_菜单组中的菜单
    
17.       (setq stct (vl-catch-all-apply
    
18.        'vlax-invoke-method
    
19.        (list mnus 'item mnuname)
    
20.      )
    
21.       )
    
22.       (if (null (vl-catch-all-error-p stct)) ;_如果存在右键弹出菜单pop0
    
23.   (progn
    
24.     (vlax-for pop stct (vlax-invoke-method pop 'delete)) ;_删除所有菜单项
    
25.     (setq i 0)
    
26.     (foreach n itemlst
    
27.       (vlax-invoke-method stct 'addmenuitem i (car n) (cadr n))
    
28.       (setq i (1+ i))
    
29.     ) ;_重新写菜单项
    
30.   )
    
31.       )
    
32.     )
    
33.   )
    
34.   stct
    
35. )

;;;=============================================<br /> ;;;      通用函数  替换菜单全部项<br /> ;;;参数： mnugname--------要修改的菜单组名<br /> ;;;       mnuname---------要修改的菜单名<br /> ;;;       itemlst-----要修改的菜单项表<br /> ;;;返回值：修改的菜单对象<br /> ;;;示例<img src="static/image/smiley/default/sad.gif" smilieid="2" border="0" alt="" />xty-mnu-changepop "acad" "默认菜单" '(("a.l""line ")))<br /> (defun xty-mnu-changepop  (mnugname mnuname itemlst / mnug mnus pop stct i)<br />   (setq  mnug (vl-catch-all-apply<br />          'vlax-invoke-method<br />          (list *xty-mnugs* 'item mnugname)<br />        ) ;_菜单组是否存在<br />   )<br />   (if (null (vl-catch-all-error-p mnug)) ;_如果存在要搜索菜单组<br />     (progn<br />       (setq mnus (vlax-get-property mnug 'menus)) ;_菜单组中的菜单<br />       (setq stct (vl-catch-all-apply<br />        'vlax-invoke-method<br />        (list mnus 'item mnuname)<br />      )<br />       )<br />       (if (null (vl-catch-all-error-p stct)) ;_如果存在右键弹出菜单pop0<br />   (progn<br />     (vlax-for pop stct (vlax-invoke-method pop 'delete)) ;_删除所有菜单项<br />     (setq i 0)<br />     (foreach n itemlst<br />       (vlax-invoke-method stct 'addmenuitem i (car n) (cadr n))<br />       (setq i (1+ i))<br />     ) ;_重新写菜单项<br />   )<br />       )<br />     )<br />   )<br />   stct<br /> )

4.主程序，写mnu文件(我用的名称是CareFromOldXia，可以相应修改)，加载到autocad。这里要考虑修改了ini文件，重新加载的方法。现阶段版本autocad都是用cuix文件，所以在重载的时候要将相关文件都删掉；注意*xty-Installfolder*全局变量，这里是我自己的默认文件夹，请根据需求自行修改。

1. (defun c:xty-cmd-updatemytb  (/ a b f i lst lst1 mymnu n)
   
2.   (setq  mymnu (vl-catch-all-apply
   
3.     'vlax-invoke-method
   
4.     (list *xty-mnugs*
   
5.           'item
   
6.           "CareFromOldXia"
   
7.           )
   
8.     )
   
9.   ) ;_获取我的工具条
   
10.   (vl-catch-all-apply
    
11.     'vlax-invoke-method
    
12.     (list mymnu
    
13.     'unload
    
14.     )
    
15.     ) ;_删除我的工具条
    
16.   (foreach n  '("CareFromOldXia.cuix"
    
17.     "CareFromOldXia.mnr"
    
18.     "CareFromOldXia_light.mnr"
    
19.     "CareFromOldXia.bak.cuix"
    
20.     )
    
21.     (vl-catch-all-apply 'vl-file-delete (list (findfile n)))
    
22.     ) ;_删除加载菜单生成文件，避免不更新
    
23.   (setq  lst  (xty-mnu-getini)
    
24.   lst1 (mapcar 'car lst)
    
25.   f    (findfile "CareFromOldXia.mnu")
    
26.   f    (open f "w")
    
27.   i    1
    
28.   )
    
29.   (write-line "***menugroup=CareFromOldXia" f)
    
30.   (write-line "***POP0" f);_这里是为其它程序预留的，可以删掉
    
31.   (write-line "**SNAP" f);_这里是为其它程序预留的，可以删掉
    
32.   (write-line "[shortcut]" f);_这里是为其它程序预留的，可以删掉
    
33.   (write-line "***TOOLBARS=allbar" f)
    
34.   (write-line "**工作模态" f)
    
35.   (write-line
    
36.     "ID_TBA_00 [_Toolbar(\"工作模态\", _Right, _show,0,0,0)]"
    
37.     f
    
38.     )
    
39.   (write-line
    
40.     "ID_TBA_01 [_Button(\"更新本工具条\",\"BMP\\\xty_modeuser_16.bmp\",\"BMP\\\xty_modeuser_32.bmp\")]^c^cxty-cmd-updatemytb"
    
41.     f
    
42.     )
    
43.   (setq  n (car lst1)
    
44.   i 0
    
45.   )
    
46.   (foreach n  lst1
    
47.     (setq a (car n)
    
48.     b (cadr n)
    
49.     )
    
50.     (write-line
    
51.       (strcat
    
52.   "ID_TBA_"
    
53.   (xty-tr-add0 (itoa (setq i (1+ i))) 2)
    
54.   " [_Button(\"工作模态切换至"
    
55.   b
    
56.   "\",\"BMP\\\xty_"
    
57.   a
    
58.   "_16.bmp\",\"BMP\\\xty_"
    
59.   a
    
60.   "_32.bmp\")]^c^c^p(setenv \"xty-myworkmode\" \""
    
61.   a
    
62.   "\");xty-cmd-menumode"
    
63.   )
    
64.       f
    
65.       )
    
66.     )
    
67.   (close f)
    
68.   (setq
    
69.     mymnu
    
70.      (vl-catch-all-apply
    
71.        'vlax-invoke-method
    
72.        (list *xty-mnugs*
    
73.        'load
    
74.        (strcat *xty-Installfolder* "\\CareFromOldXia.mnu")
    
75.        )
    
76.        )
    
77.     )
    
78.   (princ)
    
79.   )

(defun c:xty-cmd-updatemytb  (/ a b f i lst lst1 mymnu n)<br />   (setq  mymnu (vl-catch-all-apply<br />     'vlax-invoke-method<br />     (list *xty-mnugs*<br />           'item<br />           "CareFromOldXia"<br />           )<br />     )<br />   ) ;_获取我的<a href="http://bbs.mjtd.com/forum-6-1.html" target="_blank" class="relatedlink">工具</a>条<br />   (vl-catch-all-apply<br />     'vlax-invoke-method<br />     (list mymnu<br />     'unload<br />     )<br />     ) ;_删除我的工具条<br />   (foreach n  '("CareFromOldXia.cuix"<br />     "CareFromOldXia.mnr"<br />     "CareFromOldXia_light.mnr"<br />     "CareFromOldXia.bak.cuix"<br />     )<br />     (vl-catch-all-apply 'vl-file-delete (list (findfile n)))<br />     ) ;_删除加载菜单生成文件，避免不更新<br />   (setq  lst  (xty-mnu-getini)<br />   lst1 (mapcar 'car lst)<br />   f    (findfile "CareFromOldXia.mnu")<br />   f    (open f "w")<br />   i    1<br />   )<br />   (write-line "***menugroup=CareFromOldXia" f)<br />   (write-line "***POP0" f);_这里是为其它程序预留的，可以删掉<br />   (write-line "**SNAP" f);_这里是为其它程序预留的，可以删掉<br />   (write-line "[shortcut]" f);_这里是为其它程序预留的，可以删掉<br />   (write-line "***TOOLBARS=allbar" f)<br />   (write-line "**工作模态" f)<br />   (write-line<br />     "ID_TBA_00 [_Toolbar(\"工作模态\", _Right, _show,0,0,0)]"<br />     f<br />     )<br />   (write-line<br />     "ID_TBA_01 [_Button(\"更新本工具条\",\"BMP\\\xty_modeuser_16.bmp\",\"BMP\\\xty_modeuser_32.bmp\")]^c^cxty-cmd-updatemytb"<br />     f<br />     )<br />   (setq  n (car lst1)<br />   i 0<br />   )<br />   (foreach n  lst1<br />     (setq a (car n)<br />     b (cadr n)<br />     )<br />     (write-line<br />       (strcat<br />   "ID_TBA_"<br />   (xty-tr-add0 (itoa (setq i (1+ i))) 2)<br />   " [_Button(\"工作模态切换至"<br />   b<br />   "\",\"BMP\\\xty_"<br />   a<br />   "_16.bmp\",\"BMP\\\xty_"<br />   a<br />   "_32.bmp\")]^c^c^p(setenv \"xty-myworkmode\" \""<br />   a<br />   "\");xty-cmd-menumode"<br />   )<br />       f<br />       )<br />     )<br />   (close f)<br />   (setq<br />     mymnu<br />      (vl-catch-all-apply<br />        'vlax-invoke-method<br />        (list *xty-mnugs*<br />        'load<br />        (strcat *xty-Installfolder* "\\CareFromOldXia.mnu")<br />        )<br />        )<br />     )<br />   (princ)<br />   )

5.点击按钮，切换工作模态。

1. (defun c:xty-cmd-menumode (/ mode lst lst1 lst2 lst3 n)
   
2.   (setq  mode (getenv "xty-myworkmode");_此处设置环境变量"xty-myworkmode"，可根据需要修改
   
3.   lst  (xty-mnu-getini)
   
4.   lst1 (mapcar 'car lst)
   
5.   lst2 (mapcar 'car lst1)
   
6.   lst3 (mapcar 'cdr lst)
   
7.   n(-(length lst2)(length(member mode lst2)))
   
8.   lst3(nth n lst3)
   
9.   )
   
10.   (xty-mnu-changepop "acad" "默认菜单" lst3)
    
11.   (princ (strcat"\n当前工作模态切换为:"(cadr(nth n lst1))))
    
12.   (princ)
    
13. )

(defun c:xty-cmd-menumode (/ mode lst lst1 lst2 lst3 n)<br />   (setq  mode (getenv "xty-myworkmode");_此处设置环境变量"xty-myworkmode"，可根据需要修改<br />   lst  (xty-mnu-getini)<br />   lst1 (mapcar 'car lst)<br />   lst2 (mapcar 'car lst1)<br />   lst3 (mapcar 'cdr lst)<br />   n(-(length lst2)(length(member mode lst2)))<br />   lst3(nth n lst3)<br />   )<br />   (xty-mnu-changepop "acad" "默认菜单" lst3)<br />   (princ (strcat"\n当前工作模态切换为:"(cadr(nth n lst1))))<br />   (princ)<br /> )

6.一些用到的函数以及全局变量

1. ;;;全局变量
   
2. (setq *xty-acobj* (vlax-get-acad-object));_cad本身
   
3. (setq *xty-mnugs* (vlax-get-property *xty-acobj* 'MenuGroups));_菜单组集合
   
4. ;;;=============================================
   
5. ;;;      通用函数 将字符串以给定Key分解成表
   
6. ;;;参数：Str------字符串
   
7. ;;;      Key------分隔符
   
8. ;;;返回值 字符串表
   
9. (defun xty-str-ToLstBy (Str Key / i s lst)
   
10.   (while
    
11.     (setq i (vl-string-search Key Str))
    
12.      (setq
    
13.        s   (substr Str 1 i)
    
14.        Str
    
15.      (substr Str
    
16.        (+ 1
    
17.           (strlen key)
    
18.           (if i
    
19.       i
    
20.       0
    
21.           )
    
22.        )
    
23.      )
    
24.        Lst (cons s Lst)
    
25.      )
    
26.   )
    
27.   (vl-remove "" (reverse (cons str Lst)))
    
28. )
    
29. ;;;=============================================
    
30. ;;;      通用函数  加前导0
    
31. ;;;参数： str-------字符串
    
32. ;;;       n---------加零后字符串长度
    
33. ;;;返回值：加前导零后字符串
    
34. (defun xty-tr-add0 (str n)
    
35.   (setq n (- n (strlen str)))
    
36.   (repeat n (setq str (strcat "0" str)))
    
37.   str
    
38. )

;;;全局变量<br /> (setq *xty-acobj* (vlax-get-acad-object));_cad本身<br /> (setq *xty-mnugs* (vlax-get-property *xty-acobj* 'MenuGroups));_菜单组集合<br /> ;;;=============================================<br /> ;;;      通用函数 将字符串以给定Key分解成表<br /> ;;;参数：Str------字符串<br /> ;;;      Key------分隔符<br /> ;;;返回值 字符串表<br /> (defun xty-str-ToLstBy (Str Key / i s lst)<br />   (while<br />     (setq i (vl-string-search Key Str))<br />      (setq<br />        s   (substr Str 1 i)<br />        Str<br />      (substr Str<br />        (+ 1<br />           (strlen key)<br />           (if i<br />       i<br />       0<br />           )<br />        )<br />      )<br />        Lst (cons s Lst)<br />      )<br />   )<br />   (vl-remove "" (reverse (cons str Lst)))<br /> )<br /> ;;;=============================================<br /> ;;;      通用函数  加前导0<br /> ;;;参数： str-------字符串<br /> ;;;       n---------加零后字符串长度<br /> ;;;返回值：加前导零后字符串<br /> (defun xty-tr-add0 (str n)<br />   (setq n (- n (strlen str)))<br />   (repeat n (setq str (strcat "0" str)))<br />   str<br /> )

7.存在的问题，修改acad默认菜单是比较危险的事情，我现阶段的编程水准导致我无法解决该问题。我在CareFromOldXia.mnu中预留了pop0，

1.   (write-line "***POP0" f);_这里是为其它程序预留的，可以删掉
   
2.   (write-line "**SNAP" f);_这里是为其它程序预留的，可以删掉
   
3.   (write-line "[shortcut]" f);_这里是为其它程序预留的，可以删掉

  (write-line "***POP0" f);_这里是为其它程序预留的，可以删掉<br />   (write-line "**SNAP" f);_这里是为其它程序预留的，可以删掉<br />   (write-line "[shortcut]" f);_这里是为其它程序预留的，可以删掉

也预留了函数

1. ;;;=============================================
   
2. ;;;      通用函数  显示局部快捷菜单
   
3. ;;;参数： mnugname--------要修改的菜单组名
   
4. ;;;       mnuname---------要修改的菜单名
   
5. ;;;       itemlst-----要修改的菜单项表
   
6. ;;;返回值：无，显示快捷菜单
   
7. (defun xty-mnu-local  (mnugname mnuname itemlst)
   
8.   (xty-mnu-changepop mnugname mnuname itemlst)
   
9.       (menucmd "0=CareFromOldXia.POP0")
   
10.       (menucmd "0=*")
    
11. )

;;;=============================================<br /> ;;;      通用函数  显示局部快捷菜单<br /> ;;;参数： mnugname--------要修改的菜单组名<br /> ;;;       mnuname---------要修改的菜单名<br /> ;;;       itemlst-----要修改的菜单项表<br /> ;;;返回值：无，显示快捷菜单<br /> (defun xty-mnu-local  (mnugname mnuname itemlst)<br />   (xty-mnu-changepop mnugname mnuname itemlst)<br />       (menucmd "<img src="static/image/smiley/default/titter.gif" smilieid="9" border="0" alt="" />0=CareFromOldXia.POP0")<br />       (menucmd "<img src="static/image/smiley/default/titter.gif" smilieid="9" border="0" alt="" />0=*")<br /> )

但是无法找到右键弹出菜单的方法，反应器也不行，好像采用了cuix以后的版本都将右键默认菜单固定为acad.cuix。8.用到的BMP文件，可根据自己需要自定义

x_s_s_1

e2002 发表于 2022-3-29 11:24
看起来似乎是：点击了1234567这个工具栏上的某个图标，然后切换为对应的右键菜单？如果理解错误请谅解。

...

确实是点击某个图标，然后切换右键菜单。专业所致，在某个工作状态下，使用的命令大部分是重复的，搞个大面板难得找，而且只是在切换工作状态的时候才点工具栏（1.2.3.4.5...）。和ribbon的意思差不多，不过我平时ribbon是关的，节省显示区域，只有某个工作状态才打开，两个显示器都不蛮够用。

e2002

看起来似乎是：点击了1234567这个工具栏上的某个图标，然后切换为对应的右键菜单？如果理解错误请谅解。

我觉得都直接点击了图标，直接显示出一个弹出菜单列表，然后选择即可，为啥还要再去点击右键才选择呢？
而且右键菜单本来就有各种功能。

或者直接做到ribbon中去更加简单。

x_s_s_1

AndyWang 发表于 2022-3-28 09:25
支持，楼主厉害了。你那小面板有兴趣，不知是否可以分享下。

一楼已经分享了所有代码了啊，根据自己的需求去改相关文件名称和ini文件就行了，需要个性化设置的地方我都特殊标示了.

x_s_s_1

一楼以备不时之需

paulpipi

看起来好牛呀，支持

999999

顶起，，厉害了大神

AndyWang

支持，楼主厉害了。你那小面板有兴趣，不知是否可以分享下。

AndyWang

x_s_s_1 发表于 2022-3-28 09:27
一楼已经分享了所有代码了啊，根据自己的需求去改相关文件名称和ini文件就行了，需要个性化设置的地方我 ...

哦，我以为是用opendcl做的，这是用cuix实现的？

趣意人生

顶起，，厉害了大神

海盗曹

致敬大神，结构大佬~

mokson

lisp 处理菜单功能，还是很弱的，没有相关的简便的模块。