hometuf.mnl

用来计算建筑施工中的土方计算

(princ "\nHTCAD 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)
)

;;; --- 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 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 "\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)