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