xd::menu:addpopup函数存在重复加载下拉菜单的问题

dyjwyqz5221

加载方式：在工具->应用程序加载->内容 里面添加的lsp程序，其中包括自定义菜单加载内容。

启动空dwg后，
命令:
OpenDCL Runtime [9.0.6.1] loaded
晓东通用LISP函数库2020.07.28加载完毕.
晓东工具箱菜单及实用程序加载完毕。
AutoCAD 菜单实用工具 已加载。
yqz自定义菜单加载成功！！！
加载天正菜单文件: C:\Tangent\TArchT20V4\sys19x64\tch.tmn*取消*
tshowbar
命令: COMMANDLINE
命令: properties
命令:
命令:


打开一个已有图形后

不能加载菜单项: ACAD:yjk框架柱原位标注
不能加载菜单项: ACAD:yjk平法截面柱表
不能加载菜单项: ACAD:SatweYjk剪力墙校核程序
不能加载菜单项: ACAD:SatweYjk剪力墙工具
正在打开 AutoCAD 2013 格式的文件。
正在重生成模型。
晓东通用LISP函数库2020.07.28加载完毕.
晓东工具箱菜单及实用程序加载完毕。
AutoCAD 菜单实用工具 已加载。Automation 错误。 弹出菜单中存在标签为 从施工平面图中抽取详图表 的菜单项*取消*
命令:
Autodesk DWG。  此文件上次由 Autodesk 应用程序或 Autodesk 许可的应用程序保存，是可靠的 DWG。
命令:


自定义下拉菜单采用xd::menu:addpopup函数，因没有该函数的代码，无法确认哪里出问题了，
疑是：下拉菜单加载后，再打开dwg时，没进行是否已经存在下拉菜单的判断造成的。
将函数xd::menu:addpopup换成xd::menu:addpopupmenu就正常了。

XDSoft

1. (defun XD::Menu:AddPopUp
   
2.        (name lst / insertitem gemenubar menubar curmenu)
   
3.   (defun insertitem (curmenu lst / k tmp x j)
   
4.     (setq k (vla-get-count curmenu)
   
5.           j k
   
6.     )
   
7.     (mapcar
   
8.       '(lambda (x / label cmdstr)
   
9.          (setq label  (car x)
   
10.                cmdstr (cadr x)
    
11.                cmdstr (strcat "\003\003\_"
    
12.                               (xdrx-string-trimright
    
13.                                 (xdrx-string-trimleft
    
14.                                   (xdrx-string-regexpr "^[\003]+" cmdstr "")
    
15.                                   "_"
    
16.                                 )
    
17.                                 " "
    
18.                               )
    
19.                       )
    
20.          )
    
21.          (cond
    
22.            ((or (xdrx-string-regexps "^[ -]+" label) (= label ""))
    
23.             (vla-addseparator curmenu (1+ j))
    
24.            )
    
25.            ((= (type cmdstr) 'str)
    
26.             (vla-addmenuitem
    
27.               curmenu
    
28.               (1+ (vla-get-count curmenu))
    
29.               label
    
30.               (strcat cmdstr (chr 32))
    
31.             )
    
32.            )
    
33.            ((listp cmdstr)
    
34.             (insertitem (vla-addsubmenu curmenu (1+ j) label) cmdstr)
    
35.            )
    
36.          )
    
37.          (setq j (1+ j))
    
38.        )
    
39.       lst
    
40.     )
    
41.   )
    
42.   (defun getmenubar (str / curmenu menubar)
    
43.     (setq menubar (vla-get-menubar (vlax-get-acad-object)))
    
44.     (vlax-for menu menubar
    
45.       (if (= (vla-get-name menu) str)
    
46.         (setq curmenu menu)
    
47.       )
    
48.     )
    
49.     curmenu
    
50.   )
    
51.   (setq        menubar        (vla-get-menubar (vlax-get-acad-object))
    
52.         curmenu        (getmenubar name)
    
53.   )
    
54.   (if (equal nil curmenu)
    
55.     (progn (setq curmenu
    
56.                   (vla-add
    
57.                     (vla-get-menus
    
58.                       (vla-item        (vla-get-menugroups (vlax-get-acad-object))
    
59.                                 0
    
60.                       )
    
61.                     )
    
62.                     name
    
63.                   )
    
64.            )
    
65.            (vla-insertinmenubar curmenu (1+ (vla-get-count menubar)))
    
66.     )
    
67.   )
    
68.   (insertitem curmenu lst)
    
69. )
    
70. 
    

(defun XD::Menu:AddPopUp<br />        (name lst / insertitem gemenubar menubar curmenu)<br />   (defun insertitem (curmenu lst / k tmp x j)<br />     (setq k (vla-get-count curmenu)<br />           j k<br />     )<br />     (mapcar<br />       '(lambda (x / label cmdstr)<br />          (setq label  (car x)<br />                cmdstr (cadr x)<br />                cmdstr (strcat "\003\003\_"<br />                               (xdrx-string-trimright<br />                                 (xdrx-string-trimleft<br />                                   (xdrx-string-regexpr "^[\003]+" cmdstr "")<br />                                   "_"<br />                                 )<br />                                 " "<br />                               )<br />                       )<br />          )<br />          (cond<br />            ((or (xdrx-string-regexps "^[ -]+" label) (= label ""))<br />             (vla-addseparator curmenu (1+ j))<br />            )<br />            ((= (type cmdstr) 'str)<br />             (vla-addmenuitem<br />               curmenu<br />               (1+ (vla-get-count curmenu))<br />               label<br />               (strcat cmdstr (chr 32))<br />             )<br />            )<br />            ((listp cmdstr)<br />             (insertitem (vla-addsubmenu curmenu (1+ j) label) cmdstr)<br />            )<br />          )<br />          (setq j (1+ j))<br />        )<br />       lst<br />     )<br />   )<br />   (defun getmenubar (str / curmenu menubar)<br />     (setq menubar (vla-get-menubar (vlax-get-acad-object)))<br />     (vlax-for menu menubar<br />       (if (= (vla-get-name menu) str)<br />         (setq curmenu menu)<br />       )<br />     )<br />     curmenu<br />   )<br />   (setq        menubar        (vla-get-menubar (vlax-get-acad-object))<br />         curmenu        (getmenubar name)<br />   )<br />   (if (equal nil curmenu)<br />     (progn (setq curmenu<br />                   (vla-add<br />                     (vla-get-menus<br />                       (vla-item        (vla-get-menugroups (vlax-get-acad-object))<br />                                 0<br />                       )<br />                     )<br />                     name<br />                   )<br />            )<br />            (vla-insertinmenubar curmenu (1+ (vla-get-count menubar)))<br />     )<br />   )<br />   (insertitem curmenu lst)<br /> )<br /> <br />

你看看，哪里需要改

dyjwyqz5221

XDSoft 发表于 2020-7-28 10:36
你看看，哪里需要改

测试下，

dyjwyqz5221

XDSoft 发表于 2020-7-28 10:36
你看看，哪里需要改

最后这句位置有点问题，放到if的progn里面就可以了。
(if (equal nil curmenu)
                    (progn
                        (setq curmenu
                                  (vla-add
                                            (vla-get-menus
                                                      (vla-item (vla-get-menugroups (vlax-get-acad-object))
                                                        0
                                                      );;;vla
                                            );;;dvla
                                            name
                                  );;;vla
                           );;;setq
                           (vla-insertinmenubar curmenu (1+ (vla-get-count menubar)))
                        (insertitem curmenu lst)
                    );;;progn
          );;;if

aisong220