CAD生成并加载菜单文件及工具条

http://zml84.blog.sohu.com/300900739.html

2014-02-12 生成并加载菜单文件及工具条.lsp

---

(vl-load-com)
;;;=================================================================*
;;;功能：尝试获取菜单对象                                           *
;;;参数：无                                                         *
;;;返回：若成功，返回对象；否则，返回nil。                          *
;;; (fun-20140211-GetMyMenu  "制图工具")
(defun FUN-20140211-GETMYMENU (STR / MENUGROUPS MENUS I TMPMENU MYMENU)
  ;;检查菜单在当前菜单组中是否已经存在
  (setq MENUGROUPS (vla-get-menugroups (vlax-get-acad-object)))

  (setq	MYMENU NIL
	J 0
  )
  (repeat (vla-get-count MENUGROUPS)
    (setq MENUS	(vla-get-menus (vla-item MENUGROUPS J))
	  I	0
    )
    (repeat (vla-get-count MENUS)
      (setq TMPMENU (vla-item MENUS I))
      ;;(alert (vla-get-name TMPMENU))
      (if (= (vla-get-name TMPMENU) STR)
	(setq MYMENU TMPMENU)
      )
      (setq I (1+ I))
    )
    (setq J (1+ J))
  )
  ;;返回
  MYMENU
)

;;;=================================================================*
;;; 生成并加载菜单文件
(defun make-MNUfile (/ FILE LST X) 
;;0、文件放置位置选择
  (if (or (setq FILENAME (findfile "acad.mnu"))
	  (setq FILENAME (findfile "acad.cui"))
	  (setq FILENAME (findfile "acad.exe"))
	  (setq FILENAME "c:\\")
      )
    (setq
      FILENAME (strcat (vl-filename-directory FILENAME)
		       "\\制图工具tool.mnu"
	       )
    )
  )
  ;;1、生成菜单文件
      (setq FILE (open FILENAME "W"))					
      (foreach X
	       '("***MENUGROUP=制图工具G"

		 ;; 菜单
		 "\n\n***POP1"
		 "\nID_Mycad   [制图工具]"
		 "[--]"
		 "ID_MyCom [->环境建立hjjl]"
		 "ID_MyCom [新建图层A001] ^C^C^P_A001"
		 "ID_MyCom [DCL转换LSPA002] ^C^C^P_A002"
		 "ID_MyCom [图名线A003] ^C^C^P_A003"
		 "ID_MyCom [获取文件名A004] ^C^C^P_A004"
		 "ID_MyCom [剖切线A005] ^C^C^P_A005"
		 "ID_MyCom [双向阵列对象A006] ^C^C^P_A006"
		 "ID_MyCom [折断线A007] ^C^C^P_A007"
		 "ID_MyCom [布局粘贴图元A008] ^C^C^P_A008"
		 "ID_MyCom [加载交通标线A009] ^C^C^P_A009"
		 "ID_MyCom [布局删除图元A010] ^C^C^P_A010"
		 "ID_MyCom [修改随层颜色A011] ^C^C^P_A011"
		 "ID_MyCom [智能中心线A012] ^C^C^P_A012"
		 "ID_MyCom [<-删除重复图元A013] ^C^C^P_A013"
		 "[--]"
		 "ID_MyCom [->文字工具wzgj]"
		 "ID_MyCom [修改文字B001] ^C^C^P_B001"
		 "ID_MyCom [文字加注释线B002] ^C^C^P_B002"
		 "ID_MyCom [<-文字加前后缀B003] ^C^C^P_B003"		 
		 "[--]"
		 "ID_MyCom [卸载树形菜单] ^C^C^P_qq"
		 "ID_MyCom [卸载工具条] ^C^C^P_ee"

		 ;; 工具条
		 "\n\n***TOOLBARS\n**TEMPTOOLBAR"

		 "ID_ZCT001   [_Toolbar(\"工具条01\", _Floating, _Hide, 10, 340, 1)]"
		 "ID_ZCT011   [_Button(\"轴测图直线\", \"RCDATA_16_OSNEND\", \"RCDATA_16_OSNEND\")]^C^Cline"
		 "ID_ZCT012   [_Button(\"轴测图标注\", \"RCDATA_16_DIMOBL\", \"RCDATA_16_DIMOBL\")]^C^Cdim"
		 "ID_ZCT013   [_Button(\"轴测图文字\", \"RCDATA_16_TEXEDI\", \"RCDATA_16_TEXEDI\")]^C^Ctext"
		 "ID_ZCT014   [_Button(\"轴测图更改\", \"RCDATA_16_DIMOVE\", \"RCDATA_16_DIMOVE\")]^C^Cch"
		)
	(princ (strcat X "\n") FILE)	; 将定义工具栏内容写入mnu文件
      )
      (close FILE)			;_ 关闭mnu文件

      ;;2、 加载菜单
      (command "menuload" FILENAME)    
  
  (princ)
)
;;;=================================================================*
;;;功能：显示树形菜单、工具条                                       *
(defun C:RR ()
;;0、判断是否需要加在
(or  (menugroup "制图工具G")	;_判断是否已加载菜单
  ( make-MNUfile );_生成并加载菜单文件
)
  ;;1、显示树形菜单
  ;;****zml84 修改于 2014-02-11
  (and
    (setq MENUGROUPS (vla-get-menugroups (vlax-get-acad-object))
	  MENUS	     (vla-get-menus (vla-item MENUGROUPS 0))
	  MYMENU     (FUN-20140211-GETMYMENU "制图工具")
    )
    (= (vla-get-onmenubar MYMENU) :vlax-false)
    (vla-insertinmenubar MYMENU 99)
  )

  ;;2、显示工具条
  (command "TOOLBAR" "工具条01" "S")	; 显示工具栏
)
 

;;;=================================================================*
(defun C:QQ ()
  (alert "\n\n即将卸载树形菜单")
  (and (setq MYMENU (FUN-20140211-GETMYMENU "制图工具"))
       (= (vla-get-onmenubar MYMENU) :vlax-true)
       (vla-removefrommenubar MYMENU) ;_取消菜单显示
  )
  (princ)
)


;;;=================================================================*
(defun C:EE ()
  (alert "\n\n即将卸载工具条")

  (command "TOOLBAR" "工具条01" "H")
  (princ)
)
;;;=================================================================*
(c:rr)
;;;=================================================================*