来自“晓东论坛”的--动态添加传统Popup菜单

wzg356

动态增补、支持子菜单的移步http://bbs.mjtd.com/thread-188657-1-1.html

以前收集的，小改参数格式-方便录入“程序名 命令”

;动态添加传统Popup菜单-(AddPopupMenu lst)
;参数说明:lst ---- 菜单内容表 (car lst)菜单标题
;返回值:        T
;函数作者:        st788796
;适用版本:        不限
;最后更新时间:        2016-02-26
;例
;(addpopupmenu '("XDSoft" ;标题
;("曲线合并(&U)" "xdtb_curveunion") ;名称/命令
;("曲线差集(&S)" "xdtb_curvesubst")
;("") );分隔行
;)
(defun AddPopupMenu (lst  /
        pMenu:Items n curMenus pMenu Items tf  mbar mgroups name)
        (defun pMenu:Items (pMenu / pl n)
                (if (> (vla-get-count pmenu) 0)(progn
                        (setq n -1)
                        (repeat (vla-get-count pmenu)
                                (setq pl (cons (vla-item pmenu (setq n (1+ n))) pl))
                        )
                ))pl
        )        
        (setq mgroups (vla-get-menugroups (vlax-get-acad-object)))
        (setq name(car lst) mbar (vla-get-menubar (vlax-get-acad-object)))
        (if        (vl-catch-all-error-p(vl-catch-all-apply 'vla-item (list mbar name)))
                (progn                        
            (setq curMenus (vla-get-menus (vla-item mgroups 0)))
            (if (vl-catch-all-error-p(vl-catch-all-apply 'vla-item (list curMenus name)))
                    (setq pMenu (vla-add curMenus name) tf t)
                        (setq pMenu (vla-item curMenus name))
                    )
                    (setq Items (pMenu:Items pMenu))
                    (foreach x (cdr lst)
                            (if  (not(vl-some '(lambda (a)
                                            (= (strcase (vla-get-label a)) (strcase (car x)))
                                        )Items))
                                    (if (= (car x) "")
                                            (vla-addseparator pMenu (1+ (vla-get-count pMenu)))
                                            (vla-addmenuitem pMenu
                                                    (1+ (vla-get-count pMenu))
                                                    (car x)
                                                    (strcat"\003\003\_"(cadr x)" ")                                                   
                                                )
                                        )
                                )
                        )
                        (vla-insertinmenubar pmenu (1+ (vla-get-count mbar)))
                )
        )t
)

春江在线

不错不错,学习了!

uualice2020

不错，有没有删除菜单栏的？

wzg356

uualice2020 发表于 2023-10-14 20:54
不错，有没有删除菜单栏的？

改清单重开CAD图运行就行了

uualice2020

wzg356 发表于 2023-10-16 08:20
改清单重开CAD图运行就行了

好的 麻烦问下有没有二级菜单的？

llsheng_73

uualice2020 发表于 2023-10-14 20:54
不错，有没有删除菜单栏的？

自定义菜单项和工具栏
http://bbs.mjtd.com/forum.php?mo ... &fromuid=202795
(出处: 明经CAD社区)
(addMenu(list"菜单项)"))

llsheng_73

uualice2020 发表于 2023-10-16 08:37
好的 麻烦问下有没有二级菜单的？

自定义菜单项和工具栏
http://bbs.mjtd.com/forum.php?mo ... &fromuid=202795
(出处: 明经CAD社区)
(addMenu(list"房地一体(&Z)"
                      (list"折返与自交""tt1 ")
                      (list"虚交点处理""tt2 ")
                      (list"线拓扑处理""tt3 ")
                      (list"文字原位居中""tt4 ")
                      "-"
                      (list"绘制墙体归属""tt5 ")
                      (list"显示墙体归属""tt6 ")
                      (list"房屋&附属"(list(list"非闭合房屋""tt7-1 ")
                                           (list"批量房屋""tt7-2  ")
                                           (list"孤立附属与层数""tt7-3 ")
                                           (list"批量附属""tt7-4 ")
                                           (list"编辑房屋部件""tt7-5 ")
                                           ))
                      (list"宗地&权属"(list(list"批量宗地""tt8-1 ")
                                           (list"宗地排序""tt8-2 ")
                                           (list"四至分析""tt8-3 ")
                                           (list"注记宗地""tt8-4 ")
                                           ))
                      "-"
                      (list"导出房产图""tt9 ")
                      (list"导出宗地图""tt10 ")
                ))

uualice2020

llsheng_73 发表于 2023-10-16 10:36
自定义菜单项和工具栏
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=188657&fromuid=202795
(出 ...

不错 可以，，但是你自己开的贴为什么不回复人家的提问