下面是我在论坛上下的,有些地方改動了一下 ;;(setq str (gps->popupmenu '("Line" "" "Circle" "Arc"))) (DEFUN gps->popupmenu (MENULST / acadobj currmenugroup 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)) ;;(UnLoadMenuGroup "VbaMenu") ;;(vla-Load MENUS "VbaMenu.mns") (SETQ CURRMENUGROUP (vla-Item MENUS "acad")) (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=*" ) ) 我把".mns"文件的讀取和儲存取消了,把".mns"文件改成了cad已加載的菜單如“acad” 這樣是可以顯示菜單,但在MENUCMD語句中必須指定菜單标识"如POP1,POP2",而上面的程序新建菜單時是在下拉菜單的末尾新增一個下拉菜單項,也就是已加載的菜單中末尾菜單項是POP1,那麼你新增菜單項就是POP2,如果後期在".mns"文件中再增加菜單項的話,就不顯示菜單了,隻好改MENUCMD語句中“POPn”。 用下面菜單為例 MENUCMD語句也可寫成(MENUCMD "p0=VbaMenu.CMDEFAULT")***POP501 **CMDEFAULT [預設模式的上下文功能表] ID_CMNonLast [重複%s(&R)]^C^C; 如果這樣寫的問題就是上面程序新增菜單項後好像沒有指定,而(vla-Add (vla-get-Menus CURRMENUGROUP) "V&BA Menu"))中的"V&BA Menu"也就是POP501例子中的"預設模式的上下文功能表"菜單名,這個菜單名在MENUCMD語句中好像不行 請求高手幫助
|