找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 3727|回复: 29

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

[复制链接]

已领礼包: 51个

财富等级: 招财进宝

发表于 2013-5-31 20:54:45 | 显示全部楼层 |阅读模式

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

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

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

ShortCutMenu.gif
用法:

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



[sell=10]
  1. (vl-load-com)
  2. (defun ShortcutMenu  (ItemsList / MenuGroupsObj MenuObj Input AddItems MenuName *error*)
  3.   (defun AddItems (MenuObj ItemsList)
  4.     (if        ItemsList   
  5.       (if (atom (car ItemsList))
  6.         (if (= (car ItemsList) "")
  7.           (progn (vla-AddSeparator MenuObj 0) (AddItems MenuObj (cdr ItemsList)))
  8.           (progn (vla-AddMenuItem MenuObj 0 (car ItemsList) " ")
  9.                  (cons (car ItemsList) (AddItems MenuObj (cdr ItemsList)))
  10.           )
  11.         )
  12.         (append        (AddItems (vla-AddSubMenu MenuObj 0 (caar ItemsList))
  13.                           (reverse (cdar ItemsList))
  14.                 )
  15.                 (AddItems MenuObj (cdr ItemsList))
  16.         )
  17.       )
  18.     )
  19.   )
  20.   (setq MenuName "vk_Shortcut")
  21.   (if (not (vl-catch-all-error-p
  22.              (vl-catch-all-apply (function (lambda ()
  23.                                              (setq MenuGroupsObj (vla-get-MenuGroups (vlax-get-acad-object))
  24.                                                    MenuObj         (vla-Item
  25.                                                                    (vla-get-Menus
  26.                                                                      (if (menugroup MenuName)
  27.                                                                        (vla-Item MenuGroupsObj MenuName)
  28.                                                                        (if (or (findfile (strcat MenuName ".mns"))
  29.                                                                                (and (setq File (open (strcat (vl-filename-directory
  30.                                                                                                                (findfile "ACAD.mns")
  31.                                                                                                              )
  32.                                                                                                              "\\"
  33.                                                                                                              MenuName
  34.                                                                                                              ".mns"
  35.                                                                                                      )
  36.                                                                                                      "w"
  37.                                                                                                )
  38.                                                                                     )
  39.                                                                                     (write-line        (strcat        "***MENUGROUP="
  40.                                                                                                         MenuName
  41.                                                                                                         "\n***POP0\n**"
  42.                                                                                                         MenuName
  43.                                                                                                         "\n\t[Shortcut]"
  44.                                                                                                 )
  45.                                                                                                 File
  46.                                                                                     )
  47.                                                                                     (not (close File))
  48.                                                                                )
  49.                                                                            )
  50.                                                                          (vla-Load MenuGroupsObj MenuName)
  51.                                                                        )
  52.                                                                      )
  53.                                                                    )
  54.                                                                    "Shortcut"
  55.                                                                  )
  56.                                              )
  57.                                            )
  58.                                  )
  59.              )
  60.            )
  61.       )
  62.     (progn (menucmd (strcat "P0=" MenuName "." MenuName))
  63.            (vlax-map-Collection MenuObj 'vla-Delete)
  64.            (setq ItemsList (AddItems MenuObj (reverse ItemsList)))
  65.            (menucmd "P0=*")
  66.            (if (or (menucmd "P0=POP0") (= (car (setq Input (grread))) 11))
  67.              (nth (- (cadr Input) 500) (reverse ItemsList))
  68.            )
  69.     )
  70.   )
  71. )

[/sell]

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


评分

参与人数 6威望 +1 D豆 +27 收起 理由
GTJ116600 + 5 很给力!经验;技术要点;资料分享奖!
/db_自贡黄明儒_ + 5 很给力!经验;技术要点;资料分享奖!
ScmTools + 5 出题引导交流奖!
wowan1314 + 5 手机上网!懒的操作!
QiaoCheng + 2 咱是新手,没豆给少点
牢固 + 1 + 5 很给力!经验;技术要点;资料分享奖!

查看全部评分

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2013-5-31 20:58:43 | 显示全部楼层
不错!支持!
就这种菜单有用!其他就是个摆设!

点评

支持葛老观点。  发表于 2013-6-1 20:26
咋就干说呢,咋不给豆豆呢。  详情 回复 发表于 2013-5-31 21:16
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 51个

财富等级: 招财进宝

 楼主| 发表于 2013-5-31 21:16:20 | 显示全部楼层
wowan1314 发表于 2013-5-31 20:58
不错!支持!
就这种菜单有用!其他就是个摆设!

咋就干说呢,咋不给豆豆呢。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 51个

财富等级: 招财进宝

 楼主| 发表于 2013-5-31 21:17:10 | 显示全部楼层
哈,终于给威望了。:lol
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 2个

财富等级: 恭喜发财

发表于 2013-5-31 21:17:23 | 显示全部楼层
  1. ;;; HTTP://WWW.THESWAMP.ORG/INDEX.PHP?TOPIC=19339.MSG235210#MSG235210
  2. (DEFUN LOAD-DYNAMIC-POPUPMENU (MENULIST     /
  3.                                   ACADAPP      CMD
  4.                                   CURRMENUGROUP
  5.                                   DOC               LOADEDMENULIST
  6.                                   MENU               NEWMENU
  7.                                  )
  8.   (VL-LOAD-COM)
  9.   (SETQ        ACADAPP               (VLAX-GET-ACAD-OBJECT)
  10.         LOADEDMENULIST '()
  11.         DOC               (VLA-GET-ACTIVEDOCUMENT ACADAPP)
  12.         CURRMENUGROUP  (VLA-ITEM (VLA-GET-MENUGROUPS
  13.                                    (VLA-GET-APPLICATION DOC)
  14.                                  )
  15.                                  "ACAD"
  16.                        )
  17.         CMD               (LAMBDA (X)
  18.                          (STRCAT "\033\033\137" X "\040")
  19.                        )
  20.   )
  21.   (IF (/= CURRMENUGROUP NIL)
  22.     (PROGN
  23.       (VLAX-FOR        MENU (VLA-GET-MENUS CURRMENUGROUP)
  24.         (SETQ LOADEDMENULIST
  25.                (CONS
  26.                  (VLA-GET-NAMENOMNEMONIC MENU)
  27.                  LOADEDMENULIST
  28.                )
  29.         )
  30.       )
  31.       (IF (= (VL-POSITION (CAR MENULIST) LOADEDMENULIST) NIL)
  32.         (PROGN
  33.           (SETQ        NEWMENU        (VLA-ADD (VLA-GET-MENUS CURRMENUGROUP)
  34.                                  (CAR MENULIST)
  35.                         )
  36.           )
  37.           (FOREACH E (CAR (CDR MENULIST))
  38.             (VLA-ADDMENUITEM
  39.               NEWMENU
  40.               (1+ (VLA-GET-COUNT NEWMENU))
  41.               (CAR E)
  42.               (CMD (CDR E))
  43.             )
  44.           )
  45.           (VLA-INSERTINMENUBAR
  46.             NEWMENU
  47.             (1+        (VLA-GET-COUNT
  48.                   (VLA-GET-MENUBAR ACADAPP)
  49.                 )
  50.             )
  51.           )
  52.         )
  53.         (PRINC (STRCAT "\nerror of type ohno "
  54.                        (CAR MENULIST)
  55.                        " menu is already loaded "
  56.                )
  57.         )
  58.       )
  59.     )
  60.   )
  61.   (PRINC)
  62. )
  63. ;;; (LOAD-DYNAMIC-POPUPMENU '("TANER_MENU"(("T123" . "T123")("T268" . "T268"))))

点评

好程序。用该给D豆。但是真的给不出去呀。  详情 回复 发表于 2013-6-1 20:55
你这个怎么用呢?  详情 回复 发表于 2013-6-1 08:31
支持,大家把自己收集或者写的菜单代码都贴上来吧。  详情 回复 发表于 2013-5-31 21:24

评分

参与人数 2D豆 +10 贡献 +1 收起 理由
Lispboy + 5 很给力!经验;技术要点;资料分享奖!
牢固 + 5 + 1 很给力!经验;技术要点;资料分享奖!

查看全部评分

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 51个

财富等级: 招财进宝

 楼主| 发表于 2013-5-31 21:24:35 | 显示全部楼层

支持,大家把自己收集或者写的菜单代码都贴上来吧。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2013-5-31 21:25:14 | 显示全部楼层
哈哈,楼上好姑娘,让我省了10个豆

点评

好姑娘的是另外的POPUP MENU,和我的不一样你还是别省了,到时候我加分还给你  详情 回复 发表于 2013-5-31 21:36
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1632个

财富等级: 堆金积玉

发表于 2013-5-31 21:33:56 | 显示全部楼层
建议最好在例子中增加选择动作示范

点评

就是一个函数调用啊。  详情 回复 发表于 2013-5-31 21:37
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 51个

财富等级: 招财进宝

 楼主| 发表于 2013-5-31 21:36:52 | 显示全部楼层
QiaoCheng 发表于 2013-5-31 21:25
哈哈,楼上好姑娘,让我省了10个豆

好姑娘的是另外的POPUP MENU,和我的不一样你还是别省了,到时候我加分还给你:P
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 51个

财富等级: 招财进宝

 楼主| 发表于 2013-5-31 21:37:30 | 显示全部楼层
ScmTools 发表于 2013-5-31 21:33
建议最好在例子中增加选择动作示范

就是一个函数调用啊。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 2个

财富等级: 恭喜发财

发表于 2013-5-31 21:56:54 | 显示全部楼层
为啥点一楼快捷菜单为啥没有动作呢?如用DEFUN C:定义了命令TEST1,点TEST1为啥没有动作呢?

点评

在2004上测试!高版本找不到acad.mns,都用CUI了!  详情 回复 发表于 2013-5-31 22:05
冷丁吓一跳,好姑娘变纯爷们了 你把 放到你的测试命令里面就行了。  详情 回复 发表于 2013-5-31 22:04
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 51个

财富等级: 招财进宝

 楼主| 发表于 2013-5-31 22:04:11 | 显示全部楼层
taner 发表于 2013-5-31 21:56
为啥点一楼快捷菜单为啥没有动作呢?如用DEFUN C:定义了命令TEST1,点TEST1为啥没有动作呢?

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

你把

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


放到你的测试命令里面就行了。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 344个

财富等级: 日进斗金

发表于 2013-5-31 22:05:36 | 显示全部楼层
taner 发表于 2013-5-31 21:56
为啥点一楼快捷菜单为啥没有动作呢?如用DEFUN C:定义了命令TEST1,点TEST1为啥没有动作呢?

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

点评

就是在2004上测试的哦!  详情 回复 发表于 2013-5-31 22:07
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 2个

财富等级: 恭喜发财

发表于 2013-5-31 22:07:34 | 显示全部楼层
牢固 发表于 2013-5-31 22:05
在2004上测试!高版本找不到acad.mns,都用CUI了!

就是在2004上测试的哦!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2013-5-31 23:34:00 | 显示全部楼层
右键菜单我早已经发到论坛了!呵呵!个人觉的我发的哪个好看点!

点评

在什么地方呢?  发表于 2013-6-1 08:30
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-12-18 23:03 , Processed in 0.504199 second(s), 62 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表