hometuf.mnl

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

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


;;;=== 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 "无法启动 Support Assistance。")
   (princ)
)

(defun la_support_assistance_alert ()
   (alert "无法启动 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: 参数类型错。\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")