[编程交流] 需要平板电脑专家

;;; AutoLISP routines used by the AutoCAD Standard Menu.
;;;
;;; This file is loaded automatically following the menu ACAD. 
(princ "\nAutoCAD menu utilities ")
;;;=== 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** Command not allowed in a Layout **")
(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 "Invisible edges will be shown after next Regeneration.")
(princ)
)
(defun ai_hideedge_alert ()
(alert "Invisible edges will be HIDDEN after next Regeneration.")
(princ)
)
(defun ai_viewports_alert ()
(princ "** Command not allowed in Model Tab **")
(setq *error* m:err m:err nil)
(princ)
)
(defun ai_refedit_alert ()
(princ "\n** Command not allowed unless a reference is checked out with REFEDIT command **")
(setq *error* m:err m:err nil)
(princ)
)
(defun ai_support_assistance_alert ()
(alert "Could not start Support Assistance.")
(princ)
)
(defun la_support_assistance_alert ()
(alert "Could not start Learning Assistance.")
(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: Bad argument type.\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: Bad argument type.\n")
(savevar varname varvalue)
)
)
)
(T (princ "\nAI_SYSVAR: Error in first argument.\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 ) ; 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 ) ; 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 "\nEnter Tangent spec: " nil))
(setq pt2 (ai_entsnap "\nEnter second Tangent spec: " nil))
(setq pt3 (ai_entsnap "\nEnter third Tangent spec: " 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 "\nSelect object whose layer will become current: "))))
)
)
;; 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") " is now the current layer."))
;; 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 "Everything has been deselected")
(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))
)
(princ "loaded.")
(princ)