给大家提供一个制作ShortCutMenu的代码

Lispboy · 发表于 2013-5-31 20:54:45

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 Lispboy 于 2013-5-31 20:57 编辑

用法：

(defun c:tt()
(ShortcutMenu (list "Test1" "" (list "Test2" "Test21" "Test22" "" (list "Test23" "Test231" "Test232" "Test233")) "Test3" "" "Test4"))
(princ)
)

[sell=10]

(vl-load-com)
(defun ShortcutMenu (ItemsList / MenuGroupsObj MenuObj Input AddItems MenuName *error*)
(defun AddItems (MenuObj ItemsList)
(if ItemsList
(if (atom (car ItemsList))
(if (= (car ItemsList) "")
(progn (vla-AddSeparator MenuObj 0) (AddItems MenuObj (cdr ItemsList)))
(progn (vla-AddMenuItem MenuObj 0 (car ItemsList) " ")
(cons (car ItemsList) (AddItems MenuObj (cdr ItemsList)))
)
)
(append (AddItems (vla-AddSubMenu MenuObj 0 (caar ItemsList))
(reverse (cdar ItemsList))
)
(AddItems MenuObj (cdr ItemsList))
)
)
)
)
(setq MenuName "vk_Shortcut")
(if (not (vl-catch-all-error-p
(vl-catch-all-apply (function (lambda ()
(setq MenuGroupsObj (vla-get-MenuGroups (vlax-get-acad-object))
MenuObj (vla-Item
(vla-get-Menus
(if (menugroup MenuName)
(vla-Item MenuGroupsObj MenuName)
(if (or (findfile (strcat MenuName ".mns"))
(and (setq File (open (strcat (vl-filename-directory
(findfile "ACAD.mns")
)
"\\"
MenuName
".mns"
)
"w"
)
)
(write-line (strcat "***MENUGROUP="
MenuName
"\n***POP0\n**"
MenuName
"\n\t[Shortcut]"
)
File
)
(not (close File))
)
)
(vla-Load MenuGroupsObj MenuName)
)
)
)
"Shortcut"
)
)
)
)
)
)
)
(progn (menucmd (strcat "P0=" MenuName "." MenuName))
(vlax-map-Collection MenuObj 'vla-Delete)
(setq ItemsList (AddItems MenuObj (reverse ItemsList)))
(menucmd "P0=*")
(if (or (menucmd "P0=POP0") (= (car (setq Input (grread))) 11))
(nth (- (cadr Input) 500) (reverse ItemsList))
)
)
)
)

(vl-load-com) 
(defun ShortcutMenu  (ItemsList / MenuGroupsObj MenuObj Input AddItems MenuName *error*) 
  (defun AddItems (MenuObj ItemsList) 
    (if        ItemsList    
      (if (atom (car ItemsList)) 
        (if (= (car ItemsList) "") 
          (progn (vla-AddSeparator MenuObj 0) (AddItems MenuObj (cdr ItemsList))) 
          (progn (vla-AddMenuItem MenuObj 0 (car ItemsList) " ") 
                 (cons (car ItemsList) (AddItems MenuObj (cdr ItemsList))) 
          ) 
        ) 
        (append        (AddItems (vla-AddSubMenu MenuObj 0 (caar ItemsList)) 
                          (reverse (cdar ItemsList)) 
                ) 
                (AddItems MenuObj (cdr ItemsList)) 
        ) 
      ) 
    ) 
  ) 
  (setq MenuName "vk_Shortcut") 
  (if (not (vl-catch-all-error-p 
             (vl-catch-all-apply (function (lambda () 
                                             (setq MenuGroupsObj (vla-get-MenuGroups (vlax-get-acad-object)) 
                                                   MenuObj         (vla-Item 
                                                                   (vla-get-Menus 
                                                                     (if (menugroup MenuName) 
                                                                       (vla-Item MenuGroupsObj MenuName) 
                                                                       (if (or (findfile (strcat MenuName ".mns")) 
                                                                               (and (setq File (open (strcat (vl-filename-directory 
                                                                                                               (findfile "ACAD.mns") 
                                                                                                             ) 
                                                                                                             "\\" 
                                                                                                             MenuName 
                                                                                                             ".mns" 
                                                                                                     ) 
                                                                                                     "w" 
                                                                                               ) 
                                                                                    ) 
                                                                                    (write-line        (strcat        "***MENUGROUP=" 
                                                                                                        MenuName 
                                                                                                        "\n***POP0\n**" 
                                                                                                        MenuName 
                                                                                                        "\n\t[Shortcut]" 
                                                                                                ) 
                                                                                                File 
                                                                                    ) 
                                                                                    (not (close File)) 
                                                                               ) 
                                                                           ) 
                                                                         (vla-Load MenuGroupsObj MenuName) 
                                                                       ) 
                                                                     ) 
                                                                   ) 
                                                                   "Shortcut" 
                                                                 ) 
                                             ) 
                                           ) 
                                 ) 
             ) 
           ) 
      ) 
    (progn (menucmd (strcat "P0=" MenuName "." MenuName)) 
           (vlax-map-Collection MenuObj 'vla-Delete) 
           (setq ItemsList (AddItems MenuObj (reverse ItemsList))) 
           (menucmd "P0=*") 
           (if (or (menucmd "P0=POP0") (= (car (setq Input (grread))) 11)) 
             (nth (- (cadr Input) 500) (reverse ItemsList)) 
           ) 
    ) 
  ) 
)

[/sell]

也欢迎大家探讨下关于各种菜单制作的方法。

wowan1314 · 发表于 2013-5-31 20:58:43

不错！支持！
就这种菜单有用！其他就是个摆设！

Lispboy · 发表于 2013-5-31 21:16:20

wowan1314 发表于 2013-5-31 20:58
不错！支持！
就这种菜单有用！其他就是个摆设！

咋就干说呢，咋不给豆豆呢。

Lispboy · 发表于 2013-5-31 21:17:10

哈，终于给威望了。:lol

taner · 发表于 2013-5-31 21:17:23

;;; HTTP://WWW.THESWAMP.ORG/INDEX.PHP?TOPIC=19339.MSG235210#MSG235210
(DEFUN LOAD-DYNAMIC-POPUPMENU (MENULIST /
ACADAPP CMD
CURRMENUGROUP
DOC LOADEDMENULIST
MENU NEWMENU
)
(VL-LOAD-COM)
(SETQ ACADAPP (VLAX-GET-ACAD-OBJECT)
LOADEDMENULIST '()
DOC (VLA-GET-ACTIVEDOCUMENT ACADAPP)
CURRMENUGROUP (VLA-ITEM (VLA-GET-MENUGROUPS
(VLA-GET-APPLICATION DOC)
)
"ACAD"
)
CMD (LAMBDA (X)
(STRCAT "\033\033\137" X "\040")
)
)
(IF (/= CURRMENUGROUP NIL)
(PROGN
(VLAX-FOR MENU (VLA-GET-MENUS CURRMENUGROUP)
(SETQ LOADEDMENULIST
(CONS
(VLA-GET-NAMENOMNEMONIC MENU)
LOADEDMENULIST
)
)
)
(IF (= (VL-POSITION (CAR MENULIST) LOADEDMENULIST) NIL)
(PROGN
(SETQ NEWMENU (VLA-ADD (VLA-GET-MENUS CURRMENUGROUP)
(CAR MENULIST)
)
)
(FOREACH E (CAR (CDR MENULIST))
(VLA-ADDMENUITEM
NEWMENU
(1+ (VLA-GET-COUNT NEWMENU))
(CAR E)
(CMD (CDR E))
)
)
(VLA-INSERTINMENUBAR
NEWMENU
(1+ (VLA-GET-COUNT
(VLA-GET-MENUBAR ACADAPP)
)
)
)
)
(PRINC (STRCAT "\nerror of type ohno "
(CAR MENULIST)
" menu is already loaded "
)
)
)
)
)
(PRINC)
)
;;; (LOAD-DYNAMIC-POPUPMENU '("TANER_MENU"(("T123" . "T123")("T268" . "T268"))))

;;; HTTP://WWW.THESWAMP.ORG/INDEX.PHP?TOPIC=19339.MSG235210#MSG235210 
(DEFUN LOAD-DYNAMIC-POPUPMENU (MENULIST     / 
                                  ACADAPP      CMD 
                                  CURRMENUGROUP 
                                  DOC               LOADEDMENULIST 
                                  MENU               NEWMENU 
                                 ) 
  (VL-LOAD-COM) 
  (SETQ        ACADAPP               (VLAX-GET-ACAD-OBJECT) 
        LOADEDMENULIST '() 
        DOC               (VLA-GET-ACTIVEDOCUMENT ACADAPP) 
        CURRMENUGROUP  (VLA-ITEM (VLA-GET-MENUGROUPS 
                                   (VLA-GET-APPLICATION DOC) 
                                 ) 
                                 "ACAD" 
                       ) 
        CMD               (LAMBDA (X) 
                         (STRCAT "\033\033\137" X "\040") 
                       ) 
  ) 
  (IF (/= CURRMENUGROUP NIL) 
    (PROGN 
      (VLAX-FOR        MENU (VLA-GET-MENUS CURRMENUGROUP) 
        (SETQ LOADEDMENULIST 
               (CONS 
                 (VLA-GET-NAMENOMNEMONIC MENU) 
                 LOADEDMENULIST 
               ) 
        ) 
      ) 
      (IF (= (VL-POSITION (CAR MENULIST) LOADEDMENULIST) NIL) 
        (PROGN 
          (SETQ        NEWMENU        (VLA-ADD (VLA-GET-MENUS CURRMENUGROUP) 
                                 (CAR MENULIST) 
                        ) 
          ) 
          (FOREACH E (CAR (CDR MENULIST)) 
            (VLA-ADDMENUITEM 
              NEWMENU 
              (1+ (VLA-GET-COUNT NEWMENU)) 
              (CAR E) 
              (CMD (CDR E)) 
            ) 
          ) 
          (VLA-INSERTINMENUBAR 
            NEWMENU 
            (1+        (VLA-GET-COUNT 
                  (VLA-GET-MENUBAR ACADAPP) 
                ) 
            ) 
          ) 
        ) 
        (PRINC (STRCAT "\nerror of type ohno " 
                       (CAR MENULIST) 
                       " menu is already loaded " 
               ) 
        ) 
      ) 
    ) 
  ) 
  (PRINC) 
) 
;;; (LOAD-DYNAMIC-POPUPMENU '("TANER_MENU"(("T123" . "T123")("T268" . "T268"))))

Lispboy · 发表于 2013-5-31 21:24:35

taner 发表于 2013-5-31 21:17

支持，大家把自己收集或者写的菜单代码都贴上来吧。

QiaoCheng · 发表于 2013-5-31 21:25:14

哈哈，楼上好姑娘，让我省了10个豆

ScmTools · 发表于 2013-5-31 21:33:56

建议最好在例子中增加选择动作示范

Lispboy · 发表于 2013-5-31 21:36:52

QiaoCheng 发表于 2013-5-31 21:25
哈哈，楼上好姑娘，让我省了10个豆

好姑娘的是另外的POPUP MENU，和我的不一样你还是别省了，到时候我加分还给你:P

Lispboy · 发表于 2013-5-31 21:37:30

ScmTools 发表于 2013-5-31 21:33
建议最好在例子中增加选择动作示范

就是一个函数调用啊。

taner · 发表于 2013-5-31 21:56:54

为啥点一楼快捷菜单为啥没有动作呢？如用DEFUN C:定义了命令TEST1，点TEST1为啥没有动作呢？

Lispboy · 发表于 2013-5-31 22:04:11

taner 发表于 2013-5-31 21:56
为啥点一楼快捷菜单为啥没有动作呢？如用DEFUN C:定义了命令TEST1，点TEST1为啥没有动作呢？

冷丁吓一跳，好姑娘变纯爷们了

你把

(ShortcutMenu (list "Test1" "" (list "Test2" "Test21" "Test22" "" (list "Test23" "Test231" "Test232" "Test233")) "Test3" "" "Test4"))

放到你的测试命令里面就行了。

牢固 · 发表于 2013-5-31 22:05:36

taner 发表于 2013-5-31 21:56
为啥点一楼快捷菜单为啥没有动作呢？如用DEFUN C:定义了命令TEST1，点TEST1为啥没有动作呢？

在2004上测试！高版本找不到acad.mns,都用CUI了！

taner · 发表于 2013-5-31 22:07:34

牢固发表于 2013-5-31 22:05
在2004上测试！高版本找不到acad.mns,都用CUI了！

就是在2004上测试的哦！

wowan1314 · 发表于 2013-5-31 23:34:00

右键菜单我早已经发到论坛了！呵呵！个人觉的我发的哪个好看点！

账号		自动登录	找回密码
密码			立即注册

[研讨] 给大家提供一个制作ShortCutMenu的代码

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

相关帖子

点评

点评

评分

点评

点评

点评

点评

点评