wzg356 发表于 2023-10-14 18:35:57

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

本帖最后由 wzg356 于 2023-10-16 12:05 编辑


动态增补、支持子菜单的移步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 tfmbar 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
)


春江在线 发表于 2023-10-14 20:44:20

不错不错,学习了!

uualice2020 发表于 2023-10-14 20:54:25

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

wzg356 发表于 2023-10-16 08:20:27

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

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

uualice2020 发表于 2023-10-16 08:37:30

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

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

llsheng_73 发表于 2023-10-16 10:35:42

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

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

llsheng_73 发表于 2023-10-16 10:36:56

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

自定义菜单项和工具栏
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=188657&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 发表于 2023-10-16 10:49:25

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

不错 可以，，但是你自己开的贴为什么不回复人家的提问:lol:lol:lol
页: [1]
查看完整版本: 来自“晓东论坛”的--动态添加传统Popup菜单