祥子 发表于 2010-10-29 20:09:00

[求助]如何创建右键动态快捷菜单？

<p>请教各位朋友：</p>
<p>&nbsp;</p>
<p>不知用VLISP如何<font face="Verdana">创建右键动态快捷菜单，在网上找了一个，但每次运行较慢，不知有没有更快捷的方法？</font></p>
<p>&nbsp;</p>
<p>以下是网上下载的:</p><font face="Verdana">
<p><font face="Verdana">;(setq str (gps-&gt;popupmenu '("Line" "" "Circle" "Arc")))<br/>(DEFUN gps-&gt;popupmenu (MENULST / acadobj currmenugroup flag fn menus n newmenu newmenuitem openmacro str thisdoc )<br/>(SETVAR "cmdecho" 0)<br/>(SETQ FLAG nil)<br/>(SETQ FN (OPEN "VbaMenu.mns" "w"))<br/>(CLOSE FN)<br/>(SETQ ACADOBJ (vlax-get-acad-object))<br/>(SETQ THISDOC (vla-get-ActiveDocument ACADOBJ))<br/>(SETQ MENUS (vla-get-MenuGroups ACADOBJ))<br/>; (VLAX-FOR N MENUS (IF (= (vla-get-Name N) "VbaMenu")<br/>; (SETQ FLAG T)<br/>; ) (TERPRI)<br/>; )<br/>; (IF FLAG<br/>; (UnLoadMenuGroup "VbaMenu")<br/>; )<br/>(UnLoadMenuGroup "VbaMenu")<br/>(vla-Load MENUS "VbaMenu.mns")<br/>(SETQ CURRMENUGROUP (vla-Item MENUS "VbaMenu"))<br/>(IF (&lt;= (vla-get-Count (vla-get-Menus CURRMENUGROUP)) 0)<br/>(PROGN<br/>(SETQ NEWMENU (vla-Add (vla-get-Menus CURRMENUGROUP) "V&amp;BA Menu"))<br/>(FOREACH N MENULST<br/>(IF (= (TYPE N) (QUOTE STR))<br/>(COND<br/>((/= N "")<br/>(SETQ OPENMACRO (STRCAT (CHR 3) (CHR 3) "(setq xxx " N ")"<br/>(CHR 32)<br/>)<br/>NEWMENUITEM (vla-AddMenuItem NEWMENU (1+<br/>(vla-get-Count NEWMENU)<br/>) N OPENMACRO<br/>)<br/>)<br/>(vla-put-HelpString NEWMENUITEM N)<br/>)<br/>((= N "")<br/>(vla-AddSeparator NEWMENU (1+ (vla-get-Count NEWMENU)))<br/>)<br/>)<br/>)<br/>)<br/>(vla-Save CURRMENUGROUP acMenuFileCompiled)<br/>)<br/>(PRINC "\nThe menu is already loaded")<br/>) <br/>(PRIN1) <br/>(MENUCMD "p0=VbaMenu.POP2")<br/>(MENUCMD "p0=*") <br/>)<br/>(defun UnLoadMenuGroup (iValue / rValue)<br/>(if (menugroup iValue) <br/>(progn<br/>(if (not (vl-catch-all-error-p<br/>(setq rValue<br/>(vl-catch-all-apply<br/>'vla-unload<br/>(list<br/>(vla-item (vla-get-menugroups(vlax-get-acad-object)) iValue)<br/>)<br/>)<br/>)<br/>)<br/>)<br/>(setq rValue T)<br/>)<br/>rValue<br/>)<br/>)</font></p><font face="Verdana">
<p><br/>)</p>
<p><br/>&nbsp;(gps-&gt;popupmenu '("Line" "" "Circle" "Arc"))<br/>&nbsp; </font></p></font>

13579 发表于 2010-11-1 13:47:00

<p>这个有兴趣，关注中。。。</p>

祥子 发表于 2011-6-5 12:51:47

高手都哪出了啊，帖子都沉了那么久

skynoon 发表于 2011-6-19 21:22:58

关注，留下脚印

gbhsu 发表于 2011-7-25 15:50:19

笑傲江湖，顶一个！

EMD 发表于 2011-7-25 16:53:23

期待实例。帮顶。

QUAN2518 发表于 2011-7-26 11:27:05

路过 不错 顶下

cable2004 发表于 2011-10-2 11:35:10

路过 不错 顶下

CUTEE 发表于 2013-9-6 13:56:59

能改进一下好了

流动的清泉 发表于 2017-12-26 22:11:44

东西都不全吧，楼上的都是怎么看的
页: [1] 2
查看完整版本: [求助]如何创建右键动态快捷菜单？