明经源码：怎样把程序载入？
(defun create_klscl (/ f i)(if (not (menugroup "MXGJXX"))
(progn
(alert "\n程序自动创建\"MXGJXX\"菜单，请稍后")
(setq f (open "MXGJXX.mnu" "W")); 建立MXGJXX.mnu菜单文件
(write-line "***MENUGROUP=MXGJXX" f) ;
(write-line "" f) ;
(write-line "***POP1" f) ;
(write-line "" f)
(write-line " [模型工具(&X)]" f) ; 显示的菜单头，
(write-line " [--]" f)
(write-line " [图层工具(&C)]^C^CMXTC" f)
(write-line " [--]" f)
(write-line " [直线工具(&Z)]^C^CZXGJ" f)
(write-line " [->图块工具(&T)]" f)
(write-line " [快速制块(&K)]^C^CMX-ZK" f)
(write-line " [--]" f) ;
(write-line " [<-不可分解(&J)]^C^CKBFJ" f)
(close f)
(command "menuload" "MXGJXX.mnu")
(if (menugroup "MXGJXX")
(progn
(setq i 1)
(while (< i 24)
(if (menucmd (strcat "p" (itoa i) ".1=?"))
(setq i (1+ i))
(progn
(menucmd (strcat "p" (itoa i) "=+MXGJXX.pop1"))
(setq i 25)
))))))
)
(princ)
)
(create_klscl)
(defun C:QQ()
(setvar "cmdecho" 0)
(if (= "MXGJXX" (strcase (menugroup "MXGJXX")))
(progn
(vl-cmdf "menuunload" "MXGJXX")
(princ "\n菜单已成功卸载, 欢迎您再次使用")
);end_progn
);end_if
(prin1)
);end_defun
lisp创建菜单，程序怎么加载？
楼主新手吧！这个菜单源码哪捡来的不完整呢！
(defun c:加载 ()(alert "\n已经加载！"))可以参照下面的程序！
http://bbs.mjtd.com/forum.php?mo ... 860&fromuid=7318880 (出处: 明经CAD社区)]
lisp创建自定义工具栏
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
本程序由明经通道-东升铮于2018.12.16编辑！
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(DEFUN C:XZGJ () (XX-REMOVEMENUITEM "XX工具箱"));;卸载
(DEFUN C:JZGJ (/ ITEMS ITEMS1);;加载
(alert "\n欢迎使用XX工具箱")
(setq ITEMS21 (LIST '("子子菜单1" "CS:TZJZD " "介绍1")
'("--" NIL NIL)
'("子子菜单2" "LWPOLYLINE_REVERSE " "介绍2")
)
)
(setq ITEMS31 (LIST '("子子菜单1" "CS:TZJZD " "介绍1")
'("--" NIL NIL)
'("子子菜单2" "LWPOLYLINE_REVERSE " "介绍2")
)
)
(setq ITEMS41 (LIST '("子子菜单1" "CS:TZJZD " "介绍1")
'("--" NIL NIL)
'("子子菜单2" "LWPOLYLINE_REVERSE " "介绍2")
)
)
(setq ITEMS51 (LIST '("子子菜单1" "CS:TZJZD " "介绍1")
'("--" NIL NIL)
'("子子菜单2" "LWPOLYLINE_REVERSE " "介绍2")
)
)
(setq ITEMS61 (LIST '("子子菜单1" "CS:TZJZD " "介绍1")
'("--" NIL NIL)
'("子子菜单2" "LWPOLYLINE_REVERSE " "介绍2")
)
)
(setq ITEMS71 (LIST '("子子菜单1" "CS:TZJZD " "介绍1")
'("--" NIL NIL)
'("子子菜单2" "LWPOLYLINE_REVERSE " "介绍2")
)
)
(setq ITEMS1 (LIST
'("XXGJ1 【--】" "TT1 " " ")
'("XXGJ2 【--】" "TT2 " " ")
'("XXGJ3 【--】" "TT3 " " ")
)
)
(setq ITEMS2 (LIST
'("XXGJ1 【--】" "TT1 " " ")
'("XXGJ2 【--】" "TT2 " " ")
'("XXGJ3 【--】" "TT3 " " ")
)
)
(setq ITEMS3 (LIST
'("XXGJ1 【--】" "TT1 " " ")
'("XXGJ2 【--】" "TT2 " " ")
'("XXGJ3 【--】" "TT3 " " ")
)
)
(setq ITEMS (LIST (LIST "01 XX工具" nil nil ITEMS1)
(LIST "02 XX工具" nil nil ITEMS2)
(LIST "03 XX工具" nil nil ITEMS3)
)
)
(XX-ADDCASSMENU "ACAD" "XX工具箱" ITEMS "工具箱")
(PRINC)
)
(DEFUN XX-REMOVEMENUITEM (POPNAME / MENUBAR N I MENUITEM MENU TAG)
(setq MENUBAR (vla-get-MenuBar (vlax-get-acad-object)))
(setq MENUITEM (XX-CATCHAPPLY 'vla-Item (LIST MENUBAR POPNAME)))
(if MENUITEM
(PROGN
(XX-CATCHAPPLY 'vla-RemoveFromMenuBar (LIST MENUITEM))
)
)
)
(DEFUN XX-ADDCASSMENU (MENUGROUPNAME POPNAME
POPITEMS INSERTBEFOREITEM
/ MENUBAR N
I MENUITEM POPUPMENU
K TMP SUBPOPUPMENU
)
(XX-REMOVEMENUITEM POPNAME)
(setq MENUBAR (vla-get-MenuBar (vlax-get-acad-object)))
(if INSERTBEFOREITEM
(PROGN
(setq N (vla-get-Count MENUBAR))
(setq I (1- N))
(while
(and
(AND (>= I 0)
(/= INSERTBEFOREITEM
(vla-get-Name (setq MENUITEM (vla-Item MENUBAR I)))
)
)
)
(setq I (1- I))
)
(if (< I 0)
(PROGN (setq I (vla-get-Count MENUBAR)))
)
)
(PROGN (setq I (vla-get-Count MENUBAR)))
)
(if (NOT (setq POPUPMENU
(XX-CATCHAPPLY
'vla-Item
(LIST (vla-get-Menus
(vla-Item
(vla-get-MenuGroups (vlax-get-acad-object))
MENUGROUPNAME
)
)
POPNAME
)
)
)
)
(PROGN
(setq
POPUPMENU (vla-Add
(vla-get-Menus
(vla-Item
(vla-get-MenuGroups (vlax-get-acad-object))
MENUGROUPNAME
)
)
POPNAME
)
)
)
)
(VLAX-FOR POPUPMENUITEM POPUPMENU
(vla-Delete POPUPMENUITEM)
)
(vla-InsertInMenuBar POPUPMENU I)
(XX-INSERTPOPMENUITEMS POPUPMENU POPITEMS)
(PRINC)
)
(DEFUN XX-INSERTPOPMENUITEMS (POPUPMENU POPITEMS / K TMP)
(setq K 0)
(MAPCAR
'(lambda (X / LABEL CMDSTR HLPSTR SUBITEMS TMP)
(setq LABEL (CAR X))
(setq CMDSTR (CADR X))
(setq HLPSTR (CADDR X))
(setq SUBITEMS (CADDDR X))
(if (= LABEL "--")
(PROGN (vla-AddSeparator POPUPMENU (setq K (1+ K))))
(PROGN
(if (AND LABEL CMDSTR)
(PROGN (setq TMP (vla-AddMenuItem
POPUPMENU
(setq K (1+ K))
LABEL
CMDSTR
)
)
(vla-put-HelpString TMP HLPSTR)
)
(PROGN (setq
TMP (vla-AddSubMenu POPUPMENU (setq K (1+ K)) LABEL)
)
(if SUBITEMS
(PROGN (XX-INSERTPOPMENUITEMS TMP SUBITEMS))
)
)
)
)
)
)
POPITEMS
)
)
(DEFUN XX-CATCHAPPLY (FUN ARGS / RESULT)
(if (NOT (VL-CATCH-ALL-ERROR-P
(setq RESULT (VL-CATCH-ALL-APPLY
(if (= 'SYM (TYPE FUN))
(PROGN FUN)
(PROGN 'FUN)
)
ARGS
)
)
)
)
(PROGN RESULT)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:TT1 ()(alert "\n已经加载！"))
(defun c:TT2 ()(alert "\n已经加载！"))
(defun c:TT3 ()(alert "\n已经加载！"))
:L 谢谢你您..............
页:
[1]