明经源码：怎样把程序载入？

jhzlx · 发表于 2018-12-15 15:19

(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

jhzlx · 发表于 2018-12-15 15:26

lisp创建菜单，程序怎么加载？

东升铮 · 发表于 2018-12-16 21:58

楼主新手吧！这个菜单源码哪捡来的不完整呢！
(defun c:加载 () (alert "\n已经加载！"))可以参照下面的程序！
[url=lisp创建自定义工具栏 http://bbs.mjtd.com/forum.php?mo ... 860&fromuid=7318880 (出处: 明经CAD社区)]
lisp创建自定义工具栏[/url]

东升铮 · 发表于 2018-12-16 22:17

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
本程序由明经通道-东升铮于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已经加载！"))

jhzlx · 发表于 2018-12-19 13:08

谢谢你您..............

账号		自动登录	找回密码
密码			注册

[提问] 明经源码：怎样把程序载入？