;;;     ACAD.MNL
;;;     Copyright (C) 1992 - 1997 by Autodesk, Inc.
;;;
;;;     Permission to use, copy, modify, and distribute this software
;;;     for any purpose and without fee is hereby granted, provided
;;;     that the above copyright notice appears in all copies and 
;;;     that both that copyright notice and the limited warranty and 
;;;     restricted rights notice below appear in all supporting 
;;;     documentation.
;;;
;;;     AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.  
;;;     AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF 
;;;     MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC. 
;;;     DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE 
;;;     UNINTERRUPTED OR ERROR FREE.
;;;
;;;     Use, duplication, or disclosure by the U.S. Government is subject to 
;;;     restrictions set forth in FAR 52.227-19 (Commercial Computer 
;;;     Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii) 
;;;     (Rights in Technical Data and Computer Software), as applicable. 
;;;
;;;     AutoLISP routines used by the AutoCAD Standard Menu.
;;;
;;;     This file is loaded automatically following the menu ACAD.  

(princ "\nAutoCAD 菜单实用程序")


;;;=== Icon Menu Functions ===

;;;  View -> Layout -> Tiled Viewports...

(defun ai_tiledvp_chk (new)
  (setq m:err *error* *error* *merrmsg*)

  (if (= (getvar "TILEMODE") 0)
    (progn
      (princ "\n** “布局”不允许使用的命令 **")
      (princ)
    )
    (progn
      (if new
        (menucmd "I=ACAD.IMAGE_VPORTI")
        (menucmd "I=IMAGE_VPORTI")
      )
      (menucmd "I=*")
    )
  )
  (setq *error* m:err m:err nil)
  (princ)
)

(defun ai_tiledvp (num ori / ai_tiles_g ai_tiles_cmde)
  (setq m:err *error* *error* *merrmsg*
        ai_tiles_cmde (getvar "CMDECHO")
        ai_tiles_g (getvar "GRIDMODE")
  )
  (ai_undo_push)
  (setvar "CMDECHO" 0)
  (setvar "GRIDMODE" 0)
  (cond ((= num 1)
         (command "_.VPORTS" "_SI")
         (setvar "GRIDMODE" ai_tiles_g)
        )
        ((< num 4)
         (command "_.VPORTS" "_SI")
         (command "_.VPORTS" num ori)
         (setvar "GRIDMODE" ai_tiles_g)
        )
        ((= ori nil)
         (command "_.VPORTS" "_SI")
         (command "_.VPORTS" num)
         (setvar "GRIDMODE" ai_tiles_g)
        )
        ((= ori "_L")
         (command "_.VPORTS" "_SI")
         (command "_.VPORTS" "2" "")
         (setvar "CVPORT" (car (cadr (vports))))
         (command "_.VPORTS" "2" "")
         (command "_.VPORTS" "_J" "" (car (cadr (vports))))
         (setvar "CVPORT" (car (cadr (vports))))
         (command "_.VPORTS" "3" "_H")
         (setvar "GRIDMODE" ai_tiles_g)
         (setvar "CVPORT" (car (cadddr (vports))))
         (setvar "GRIDMODE" ai_tiles_g)
         (setvar "CVPORT" (car (cadddr (vports))))
         (setvar "GRIDMODE" ai_tiles_g)
         (setvar "CVPORT" (car (cadddr (vports))))
         (setvar "GRIDMODE" ai_tiles_g)
        )
        (T
         (command "_.VPORTS" "_SI")
         (command "_.VPORTS" "2" "")
         (command "_.VPORTS" "2" "")
         (setvar "CVPORT" (car (caddr (vports))))
         (command "_.VPORTS" "_J" "" (car (caddr (vports))))
         (setvar "CVPORT" (car (cadr (vports))))
         (command "_.VPORTS" "3" "_H")
         (setvar "GRIDMODE" ai_tiles_g)
         (setvar "CVPORT" (car (cadddr (vports))))
         (setvar "GRIDMODE" ai_tiles_g)
         (setvar "CVPORT" (car (cadddr (vports))))
         (setvar "GRIDMODE" ai_tiles_g)
         (setvar "CVPORT" (car (cadddr (vports))))
         (setvar "GRIDMODE" ai_tiles_g)
        )
  )
  (ai_undo_pop)
  (setq *error* m:err m:err nil)
  (setvar "CMDECHO" ai_tiles_cmde)
  (princ)
)


;;;=== General Utility Functions ===

;;; ai_popmenucfg -- retrieve parameter from cfg settings
;;; <param> is a string specifiying the parameter
 
(defun ai_popmenucfg (param)
  (set (read param) (getcfg (strcat "CfgData/Menu/" param)))
)

;;; ai_putmenucfg -- store parameter in cfg settings
;;; <param> is a string specifiying the parameter
;;; <cfgval> is the value for that parameter

(defun ai_putmenucfg (param cfgval)
  (setcfg (strcat "CfgData/Menu/" param) cfgval)
)

(defun *merr* (msg)
  (ai_sysvar nil) ;; reset system variables
  (setq *error* m:err m:err nil)
  (princ)
)

(defun *merrmsg* (msg)
  (princ msg)
  (setq *error* m:err m:err nil)
  (princ)
)


(defun ai_showedge_alert ()
   (alert "下次重生成时显示不可见边。")
   (princ)
)

(defun ai_hideedge_alert ()
   (alert "下次重生成时隐藏不可见边。")
   (princ)
)

(defun ai_viewports_alert ()
   (princ "** 命令不允许在模型选项卡中使用 **")
   (setq *error* m:err m:err nil)
   (princ)
)

(defun ai_refedit_alert ()
   (princ "\n** 除非参照已用 REFEDIT 命令检查，否则不允许使用该命令 **")
   (setq *error* m:err m:err nil)
   (princ)
)

(defun ai_support_assistance_alert ()
   (alert "无法启动“支持助手”。")
   (princ)
)

(defun la_support_assistance_alert ()
   (alert "无法启动“学习助手”。")
   (princ)
)

;;; --- ai_sysvar ------------------------------------------
;;; Change system variable settings and save current settings
;;; (Note: used by *merr* to restore system settings on error.)
;;;
;;; The <vars> argument is used to... 
;;;   restore previous settings (ai_sysvar NIL)
;;;   set a single sys'var (ai_sysvar  '("cmdecho" . 0))
;;;   set multiple sys'vars (ai_sysvar '(("cmdecho" . 0)("gridmode" . 0)))
;;;
;;; defun-q is needed by Visual Lisp for functions which redefine themselves.
;;; it is aliased to defun for seamless use with AutoLISP.

(defun-q ai_sysvar (vars / savevar pair varname varvalue varlist)

   (setq varlist nil)  ;; place holder for varlist

   (defun savevar (varname varvalue / pair)
      (cond
             ;; if new value is NIL, save current setting
         ((not varvalue) 
            (setq varlist 
               (cons 
                   (cons varname (getvar varname)) 
                    varlist
               )
            )
             )
                 ;; change sys'var only if it's different
         ((/= (getvar varname) varvalue)
                 ;; add current setting to varlist, change setting
             (setq varlist 
                (cons 
                   (cons varname (getvar varname)) 
                    varlist
                )
             )
             (setvar varname varvalue)
             )
                 (T nil)
          )
   )

   (cond
          ;; reset all values
      ((not vars)
         (foreach pair varlist
            (setq  varname (car pair)  
                  varvalue (cdr pair)
            )
            (setvar varname varvalue)
                 )
         (setq varlist nil) 
          )

          ((not (eq 'LIST (type vars)))
              (princ "\nAI_SYSVAR: 参数类型错。\n")
          )

          ;; set a single system variable
      ((eq 'STR (type (car vars)))
         (savevar (car vars) (cdr vars))

          )

          ;; set multiple system variables
      ((and 
                (eq 'LIST (type (car  vars)))
            (eq 'STR  (type (caar vars)))
           )
         (foreach pair vars
            (setq  varname (car pair)  
                  varvalue (cdr pair)
            )
            (if (not (eq 'STR (type varname)))
                (princ "\nAI_SYSVAR: 参数类型错。\n")
                (savevar varname varvalue)
            )
                 )
          )
      
      (T (princ "\nAI_SYSVAR: 第一个参数有错。\n"))
   
   );cond
   
   ;; redefine ai_sysvar function to contain the value of varlist
   (setq ai_sysvar 
      (cons (car ai_sysvar) 
              (cons (list 'setq 'varlist (list 'quote varlist))
                        (cddr ai_sysvar)
                  )
          )
   )

   varlist  ;; return the list

);sysvar


;;; return point must be on an entity
;;;
(defun ai_entsnap (msg osmode / entpt)
   (while (not entpt)
          (setq entpt (last (entsel msg)))
   )
   (if osmode 
      (setq entpt (osnap entpt osmode))
   )
   entpt
)

;;; 
;;; These UNDO handlers are taken from ai_utils.lsp and copied here to
;;; avoid loading all of ai_utils.lsp. Command echo control has also
;;; been added so that UNDO commands aren't echoed everywhere.
;;;
;;; UNDO handlers.  When UNDO ALL is enabled, Auto must be turned off and 
;;; GROUP and END added as needed. 
;;;
(defun ai_undo_push()
  (ai_sysvar '("cmdecho" . 0))
  (setq undo_init (getvar "undoctl"))
  (cond
    ((and (= 1 (logand undo_init 1))   ; enabled
          (/= 2 (logand undo_init 2))  ; not ONE (ie ALL is ON)
          (/= 8 (logand undo_init 8))   ; no GROUP active
     )
      (command "_.undo" "_group")
    )
    (T)
  )  
  ;; If Auto is ON, turn it off.
  (if (= 4 (logand 4 undo_init))
      (command "_.undo" "_auto" "_off")
  )
  (ai_sysvar NIL)
)

;;;
;;; Add an END to UNDO and return to initial state.
;;;
(defun ai_undo_pop()
  (ai_sysvar '("cmdecho" . 0))
  (cond 
    ((and (= 1 (logand undo_init 1))   ; enabled
          (/= 2 (logand undo_init 2))  ; not ONE (ie ALL is ON)
          (/= 8 (logand undo_init 8))   ; no GROUP active
     )
      (command "_.undo" "_end")
    )
    (T)
  )  
  ;; If it has been forced off, turn it back on.
  (if (= 4 (logand undo_init 4))
    (command "_.undo" "_auto" "_on")
  )  
  (ai_sysvar NIL)
)

;;;=== Menu Functions ======================================

(defun ai_rootmenus ()
  (setq T_MENU 0)
  (menucmd "S=S")
  (menucmd "S=ACAD.S")
  (princ)
)

(defun c:ai_fms ( / fmsa fmsb)
  (setq m:err *error* *error* *merr*)
  (ai_undo_push)
  (if (getvar "TILEMODE") (setvar "TILEMODE" 0))
  (setq fmsa (vports) fmsb (nth 0 fmsa))
  (if (member 1 fmsb)
    (if (> (length fmsa) 1)
      (command "_.mspace")
      (progn
        (ai_sysvar '("cmdecho" . 1))
        (command "_.mview")
        (while (eq 1 (logand 1 (getvar "CMDACTIVE")))
          (command pause)
        )
        (ai_sysvar NIL)
        (command "_.mspace")
      )
    )
  )
  (ai_undo_pop)
  (setq *error* m:err m:err nil)
  (princ)
)

(defun ai_onoff (var)
  (setvar var (abs (1- (getvar var))))
  (princ)
)

;;; go to paper space
(defun c:ai_pspace ()
  (ai_undo_push)
  (if (/= 0 (getvar "tilemode"))
    (command "_.tilemode" 0)
  )
  (if (/= 1 (getvar "cvport"))
    (command "_.pspace")
  )
  (ai_undo_pop)
  (princ)
)

;;; go to tilemode 1
(defun c:ai_tilemode1 ()
  (ai_undo_push)
  (if (/= 1 (getvar "tilemode"))
    (command "_.tilemode" 1)
  )
  (ai_undo_pop)
  (princ)
)

;;; Pop menu Draw/ Dim/ Align Text/ Centered
;;; Toolbar Dimensions/ Align Text/ Centered

(defun ai_dim_cen (/ ai_sysvar ai_dim_ss)
  (setq ai_sysvar (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (cond
    ((setq ai_dim_ss (ssget  "_P" '((0 . "DIMENSION"))))
      (command "_.dimoverride" "_dimjust" 0 "" ai_dim_ss "" 
               "_.dimtedit" ai_dim_ss "_h")
    )
    (T nil)
  )
  (setvar "cmdecho" ai_sysvar)
  (princ)
)

;;; Shortcut menu for Dimension Text Above 

(defun c:ai_dim_textabove (/ ss)
  (ai_sysvar '("cmdecho" . 0))
  (if (setq ss (ssget "_I"))
    (command "_.dimoverride" "_dimtad" 3 "" ss "")
    (if (setq ss (ssget))
      (command "_.dimoverride" "_dimtad" 3 "" ss "") 
    )
  )
  (ai_sysvar NIL)
  (princ)
)

;;; Shortcut menu for Dimension Text Center 

(defun c:ai_dim_textcenter (/ ss)
  (ai_sysvar '("cmdecho" . 0))
  (if (setq ss (ssget "_I"))
    (command "_.dimoverride" "_dimtad" 0 "" ss "")
    (if (setq ss (ssget))
      (command "_.dimoverride" "_dimtad" 0 "" ss "") 
    )
  )
  (ai_sysvar NIL)
  (princ)
)

;;; Shortcut menu for Dimension Text Home 

(defun c:ai_dim_texthome (/ ss)
  (ai_sysvar '("cmdecho" . 0))
  (if (setq ss (ssget "_I"))
    (command "_.dimedit" "_h")
    (if (setq ss (ssget))
      (command "_.dimedit" "_h" ss)
    )
  )
  (ai_sysvar NIL)
  (princ)
)


;;; Screen menu item for CIRCLE TaTaTan option.
;;;     first, get points on entities
(defun ai_circtanstart()
   (setq m:err *error* *error* *merr*)
   (ai_sysvar 
      (list '("cmdecho" . 0)
         ;; make sure _tan pick for CIRCLE gets same entity
         (cons "aperture"  (getvar "pickbox"))
          )
   )
   ;; prompts are the same as CIRCLE/TTR command option
   (setq pt1 (ai_entsnap "\n输入切点定义: "  nil))
   (setq pt2 (ai_entsnap "\n输入第二个切点的定义: " nil))
   (setq pt3 (ai_entsnap "\n输入第三个切点的定义: "  nil))
)
;;; Command-line version
(defun c:ai_circtan (/ pt1 pt2 pt3)
   (ai_circtanstart)

   (ai_sysvar '("osmode" . 256))
   (command "_.circle" "_3p" "_tan" pt1 "_tan" pt2 "_tan" pt3)
   
   (ai_sysvar nil)
   (setq *error* m:err m:err nil)
   (princ)
)
;;; Use this if CMDNAMES == CIRCLE
(defun ai_circtan (/ pt1 pt2 pt3)
   (ai_circtanstart)

   (ai_sysvar '("osmode" . 256))
   (command "_3p" pt1  pt2  pt3)
   
   (ai_sysvar nil)
   (setq *error* m:err m:err nil)
   (princ)
)



;;;=== Make Object's Layer Current =============================

;; Makes the layer of the selected object current.  If there is one
;; object in the pickfirst set, it's layer is made current without
;; prompting for an object.  Else a prompt is issued.
(defun c:ai_molc(/ old_error end_undo old_cmdecho set1 ent undo_control)
  
  ;; Simple error handling.
  (defun molc_error (s)
    ;; Reset error handling.
	(if old_error (setq *error* old_error))
	;; End undo if we started one.
	(if (eq end_undo 1) (command "_.undo" "_end"))
	;; Reset command echo
	(if old_cmdecho (setvar "cmdecho" old_cmdecho))
	;; Silent exit.
	(princ)
  )
  
  ;; Save current error function.
  (setq old_error *error*)
  
  ;; Set error handling to molc's error function.
  (setq *error* molc_error)
  
  ;; Save cmdecho setting.
  (setq old_cmdecho (getvar "cmdecho"))
  
  ;; Turn off cmdecho
  (setvar "cmdecho" 0)
   
  ;; If Pickfirst is on and the selction set contains 
  ;; one object, then use it, else prompt for one.
  (if (and (eq 1 (logand 1 (getvar "pickfirst")))
            (setq set1 (ssget  "_i"))
	        (eq 1 (sslength set1))
	  )
     (progn 
	   (setq ent (entget (ssname set1 0)))   	 
       (sssetfirst nil nil)
	 )
	 (progn 
	   (sssetfirst nil nil)
	   (setq ent (entget (car (entsel "\n选择将使其图层成为当前图层的对象:  "))))
	 )
  )
  
  ;; Get undo setting.
  (setq undo_control (getvar "undoctl"))
  
  ;; Initialize flag to to end undo.
  (setq end_undo 0)
  
  ;; Begin Undo group if need be.
  (if (and (= 1 (logand 1 undo_control))   ; undo on
           (/= 2 (logand 2 undo_control))  ; not single undo
      	   (/= 8 (logand 8 undo_control))  ; no active group
	  )
	  (progn 
	    ;; Begin a new one
		(command "_.undo" "_begin")
   		;; Set flag so that we know to end undo.
	    (setq end_undo 1)
      )
  )

  ;; Make object's layer current.
  (setvar "clayer" (cdr (assoc '8 ent)))
  
  ;; Print message
  (princ (strcat "\n" (getvar "clayer") " 现在是当前图层。"))
    
  ;; Undo end
  (if (eq 1 end_undo)
    (command "_.undo" "_end")
  )
  
  ;; Turn on cmdecho
  (setvar "cmdecho" old_cmdecho)
  
  ;; Reset error function.
  (setq *error* old_error)
  
  ;; Silent exit.
  (princ)
)

;;; Shortcut menu Deselect All item.

(defun ai_deselect ()
   (if (= (getvar "cmdecho") 0)			;start if
       (command "_.select" "_r" "_all" "")
       (progn					;start progn for cmdecho 1
           (setvar "cmdecho" 0)
           (command "_.select" "_r" "_all" "")
           (setvar "cmdecho" 1)
       )					;end progn for cmdecho 1
   )						;end if
   (terpri)
   (prompt "所有对象都已取消选择")
   (princ)
)

;;;
;;; Enable Draworder to be called from a menu
;;; Checks for Pickfirst selected objects
;;;

(defun ai_draworder (option / ss )

  (setq m:err *error* *error* *merr*)
  (ai_sysvar '("cmdecho" . 0))

  (if (setq ss (ssget "_I"))
    (command "_.draworder" option)
    (if (setq ss (ssget))
      (command "_.draworder" ss "" option)
    )
  )
  (ai_sysvar NIL)
  (setq *error* m:err m:err nil)

  (princ)
)

(defun c:vlisp ()
  (if (/= nil c:vlide) (c:vlide))
)
(defun put_toolbar_visible(groupname toolbarname enVisible)
	(vl-load-com)
	(if(not(vl-catch-all-error-p	
					(setq mgroup (vl-catch-all-apply 'vla-item			
						(list (vla-get-menugroups (vlax-get-acad-object)) groupname)
					)	
				)	
			)	
		)
		(setq toolbar (vla-item (vla-get-toolbars mgroup) toolbarname)) 
	);if
	(if enVisible
		(vla-put-visible toolbar :vlax-true)
		(vla-put-visible toolbar :vlax-false)
	)		
)
(put_toolbar_visible "KYQ" "地理信息" nil)
(put_toolbar_visible "KYQ" "探矿权信息" nil)
(put_toolbar_visible "KYQ" "采矿权信息" nil)
(put_toolbar_visible "KYQ" "辅助工具" nil)
(put_toolbar_visible "KYQ" "窗口比例" nil)

(setvar "cmdecho" 0)
(setvar "Lispinit" 0)
(setvar "SDI" 1)
(setvar "Modemacro" "矿业权图形入库数字化")
(setq Udflst(list "new" "open" "save" "saveas" "line" "pline" "spline" "circle" "insert" "pedit" "text" "mline"))
(while(setq Udf(car Udflst))
	(command "_.undefine" Udf)
	(setq Udflst(cdr Udflst))
)
(princ "\nOk for Undefine.")

(defun get_AcadPath(/ acadPath n)
  (setq acadPath(getenv "ACADDRV"))
  (setq n(strlen acadPath))
  (substr acadPath 1 (- n 3))
)
(defun set_PLsupportPath(PLsupportLst / allPath acadPath PLmainPath n i ws)
	(setenv "ACAD" "")
  (setq allPath(getenv "ACAD"))
  (setq acadPath(get_AcadPath))
  (setq PLmainPath(strcat acadPath "Support\\" (car PLsupportLst)))
  (setq allPath(strcat allPath ";" PLmainPath))
	(setq n(length PLsupportLst))
	(setq i 1)
	(while(< i n)
		(setq ws(nth i PLsupportLst))
		(setq ws(strcat PLmainPath "\\" ws)) 
  		(setq allPath(strcat allPath ";" ws))
  		(setq i(1+ i))
	)
  (setenv "ACAD" allPath)
  t
)
(arxload "OpenDCL.16.arx")
(arxload "hytLib2006.arx") 
(arxload "doslib16.arx") 

(set_PLsupportPath '("KYQ_Project" "Sym" "Odcl" "Res" "Legend"))
(princ "\nOk for PLsupportPath.")
(setq PLmap(getvar "Menuname"))
(princ "\nOk for get Menuname.")
(if(/=(load PLmap "Load plmap failed.") "Load plmap failed.")
  (princ "\nKYQ祝工作顺利.\n")
  (princ "\nKYQ.vlx加载失败.\n")
)
(setq PLmap nil)
(princ)

