mvsetup.lsp

Autocad-2005-简体中文-解密版.zip

;;;
;;; mv_ctm == MView_Check_TileMode
;;;
(defun mv_ctm ()
  (if (= (getvar "TILEMODE") 1) 
    (progn
      (initget "Yes No")
      
      (setq ans (getkword "\nEnable paper space? [No/Yes] <Y>: "))
      
      (if (= ans "No")
        T
        (progn
          (setvar "TILEMODE" 0)
          nil
        )
      )
    )
    nil
  )
)
;;;
;;; Do a new setup relative to a point to be given by the user.
;;; The default is the current 0,0,0.
;;;
;;; mv_dns == MView_Do_New_Setup
;;;
(defun mv_dns (/ mv_ver mv_xdf mv_xlf o_cvpt ans sset ITEM_LIST fd program var)

  ;; Get program name
  (if (not (setq program (getvar "program")))
     (setq program "acad")
  )
  (if (= program "acad")
     (setq var "acadprefix")
	 ; else
	 (setq var "exedir")
  )

  (setq mv_ver "2.0")                ; Reset this local if you make a change.
  (setq mv_xpf (mv_cpf (getvar var )))
  
  (setq mv_xdf (strcat mv_xpf "mvsetup.dfs"))         
  (setq mv_xlf "mvsetup.lsp")         ; Reset these locals if you make changes.
  
  (setq uctr 0)
  (setq o_cvpt (getvar "cvport"))
  (if (/= o_cvpt 1)
    (command "_.PSPACE")               ; Change to paperspace
  )
                                        
  ;; Look for external definitions --  set fd to file descriptor
  (setq fd (mv_lfx mv_xdf "r"))         
                                        
  ;; Close the file, but do not set the handle to nil.
  (if fd (close fd))
                                        
  (if (null fd)
    ;; then
    (progn
      (princ (strcat "\nCreating the default file mvsetup.dfs" 
                     "\nin the directory "
                     mv_xpf ". "))
      (mv_cdf)
      (setq fd (mv_lfx mv_xdf "r"))

      ;; Close the file; we were just checking to see if it was there.
      (close fd)
    )
    ;; else
  )
  (setq temp T
        mv_utr "in"
  )
  (while temp
    (initget "Align Create Scale Title Undo Options")
    (setq ans (getkword (strcat
      "\nEnter an option [Align/Create/Scale viewports/"
      "Options/Title block/Undo]: ")))
      
    (cond
      ((= ans "Align")
        (mv_vpa)                      ; Viewport alignment
      )
      ((= ans "Create")
        (setq temp1 T)
        (while temp1
          (initget "Create Delete Undo")
          (setq ans (getkword 
            "\nEnter option [Delete objects/Create viewports/Undo] <Create>: "))
          (cond
            ((= ans "Delete")
              (command "_.UNDO" "_GROUP")
              (setq uctr (1+ uctr))
          
              (princ "\nSelect the objects to delete... ")
              (setq sset (ssget))
              (if sset
                (command "_.ERASE" sset "")
              )
              (command "_.UNDO" "_EN")
            )
            ((= ans "Undo")
              (cond
                ((= uctr 0) (princ "\nNothing to undo. \n"))
                ((> uctr 0) 
                  (command "_.U")
                  (setq uctr   (- uctr 1)
                        ll_crn nil
                  )
                )
              ) 
            )
            (T
              (command "_.UNDO" "_GROUP")
              (setq uctr (1+ uctr))
              (setq temp1 nil)
              (if (setq deffi (mv_lfx mv_xdf "r"))
                (progn
                  (textpage)
                  (setq str1 "\nAvailable layout options: . . . \n")
            
                  (setq vp_item_list (mv_pao "MVIEWS" str1))
            
                  (if (and (= (type vp_item_list) 'LIST) (null skip))
                    (mv_mvi)
                  )
                  (setq deffi (close deffi))
                )
                (princ (strcat "\nCouldn't open the file " mv_xdf " for reading. "))
              )
              (command "_.UNDO" "_EN")
            )
          )
        )
        (command "_.UNDO" "_EN")
      )
      ((= ans "Options")
        (mv_sop)                      ; Set options
      )
      ((= ans "Scale")
        (mv_szs)                      ; Set zoom scale factors
      )
      ((= ans "Title")
        (setq temp1 T)
        (while temp1
          (if (/= (getvar "cvport") 1)
            (command "_.PSPACE")
          )
          (initget "Delete Origin Insert Undo")
          (setq ans (getkword 
            "\nEnter title block option [Delete objects/Origin/Undo/Insert] <Insert>: "))
          (cond
            ((= ans "Delete")
              (command "_.UNDO" "_GROUP")
              (setq uctr (1+ uctr))

              (princ "\nSelect the objects to delete... ")
              (setq sset (ssget))
              (if sset
                (command "_.ERASE" sset "")
              )
              (command "_.UNDO" "_EN")
            )
            ((= ans "Origin")
              (command "_.UNDO" "_GROUP")
              (setq uctr (1+ uctr))

              ;; Get an origin point for the new title block.
              (initget 1)
              (setq ans (getpoint '(0 0 0) 
                "\nSpecify new origin point for this sheet: "))
              (command "_.UCS" "_O" ans)
              (command "_.UNDO" "_EN")
            )
            ((= ans "Undo")
              (cond
                ((= uctr 0) (princ "\nNothing to undo. \n"))
                ((> uctr 0) 
                  (command "_.U")
                  (setq uctr   (- uctr 1)
                        ll_crn nil
                  )
                )
              ) 
            )
            (T
              (command "_.UNDO" "_GROUP")
              (setq uctr (1+ uctr))
              (setq temp1 nil)
              (if fd
                (mv_gop)
                (princ (strcat 
                  "\nCouldn't open the file " mv_xdf " for reading. "))
              )
              (command "_.UNDO" "_EN")			  
            )
          )
        )
        (command "_.UNDO" "_EN")
      )
      ((= ans "Undo")
        (cond
          ((= uctr 0) (princ "\nNothing to undo. \n"))
          ((> uctr 0) 
            (command "_.U")
            (setq uctr   (- uctr 1)
                  ll_crn nil
            )
          )
        ) 
      )
      (T
        (setq temp nil)
      )
    )
  )
  (if (/= o_cvpt 1)
    (progn
      (setq sset (ssget "_x" '((0 . "VIEWPORT"))))
      (if sset 
        (setq o_cvpt (mv_vvp o_cvpt sset))
        (setq o_cvpt nil)
      )
      (command "_.MSPACE")              ; Change to modelspace
      ;; If the previously current viewport has been deleted,
      ;; this will do nothing.
      (if o_cvpt (setvar "cvport" o_cvpt)) ; Restore previous active viewport
    )
  )
)
;;;
;;; Set preference options.
;;;
;;; mv_sop == MView_Set_OPtions
;;;
(defun mv_sop (/ temp lay cont)
  ;;;
  ;;; Prompt for a layer name.
  ;;;
  (defun getsymbolstring (p / resp)
    (setq resp ; raw response
      (getstring
        (if (or (eq (getvar "EXTNAMES") 0)
                (eq (logand (getvar "CMDACTIVE") 4) 4)) nil 1)
        p))
    (if (wcmatch resp "\"*\"")
      (setq resp (substr resp 2 (- (strlen resp) 2))))
    (ai_strtrim resp)
  )

  (setq cont T)
  (while cont
    (initget "Layer LImits Units Xref")
    (setq temp (getkword (strcat "\nEnter an option [Layer/LImits/Units/Xref] <exit>: ")))
    (cond
      ((= temp "Layer")
        (setq mv_oln (getvar "CLAYER"))
        (setq temp (if mv_nln (strcat " <" mv_nln ">: ") ": "))
        (setq temp (getsymbolstring (strcat
"\nEnter layer name for title block or [. (for current layer)]" temp))
        )
        (cond
          ((= temp "")
            (setq mv_nln nil)
          )
          ((= temp ".")
            (setq mv_nln nil)
          )
          (T
            (if (snvalid temp)
              (progn
                (if (setq lay (tblsearch "LAYER" temp))
                  (if (= (logand (cdr(assoc 70 lay)) 2) 2)
                    (command "_.LAYER" "_THAW" temp "")
                  )
                  (command "_.LAYER" "_NEW" temp "")
                )
                (setq mv_nln temp)
              )
              (princ "\nInvalid layer name.\n")
            )
          )
        )
      )
      ((= temp "LImits")
        (setq temp (if mv_slr "Y" "N"))
        (initget "Yes No")
        (setq temp (getkword (strcat "\nSet drawing limits? [Yes/No] <"
                              temp ">: ")))
        (if mv_slr
          (if (= temp "No")
            (setq mv_slr nil)
            (setq mv_slr T)
          )
          (if (= temp "Yes")
            (setq mv_slr T)
            (setq mv_slr nil)
          )
        )
      )
      ((= temp "Units")
        (setq temp (if mv_utr mv_utr "in"))
        (initget "Mm Millimeters Inches MEters Feet")
        (setq temp (getkword (strcat 
          "\nEnter paper space units type [Feet/Inches/MEters/Millimeters] <"
          temp ">: "))
        )
        (if temp
          (cond
            ((= temp "Millimeters") (setq mv_utr "mm"))
            ((= temp "Mm")          (setq mv_utr "mm"))
            ((= temp "MEters")      (setq mv_utr "m"))
            ((= temp "Feet")        (setq mv_utr "ft"))
            ((= temp "Inches")      (setq mv_utr "in"))
            (T (princ))
          )
        )
      )
      ((= temp "Xref")
        (setq temp (if mv_uxr "Xref" "Insert"))
        (initget "Xref Insert")
        (setq temp (getkword (strcat 
          "\nEnter title block placement method [Xref attach/Insert] <"
          temp ">: "))
        )
        (if mv_uxr
          (if (= temp "Insert")
            (setq mv_uxr nil)
            (setq mv_uxr T)
          )
          (if (= temp "Xref")
            (setq mv_uxr T)
            (setq mv_uxr nil)
          )
        )
      )
      (T
        (setq cont nil)
      )
    )
  )
)
;;;
;;; Return the first path in ACADPREFIX delimited by `;'.
;;;
;;; mv_cpf == MView_Check_acadPreFix
;;;
(defun mv_cpf (pf / temp)
  (setq j 1
        l (strlen pf)
  )
  (while (<= j l)
    (if (= (substr pf j 1) ";")
      (progn
        (setq temp (substr pf 1 (1- j)))
        (setq j (1+ l))
      )
      (setq j (1+ j))
    )
  )
  
  ;; Use passed in string if temp is nil.
  (if (= temp nil)
    (setq temp pf)
  )

  ;; If temp does not end in a backslash, add one.
  (if temp
    (if (/= (substr temp (strlen temp) 1) "\\")
	  (setq temp (strcat temp "\\"))
	)
  )
  
  ;; Return path 
  temp
)
;;;
;;; Verify the Mview viewport whose number we have in vp_n.
;;;
;;; mv_vvp == MView_Verify_ViewPort
;;;
(defun mv_vvp (num sset / j vp ss_len cont)
  (setq ss_len (sslength sset)
        j      0
        cont   T
  )
  (while (and cont (< j ss_len))
    (setq temp (entget (ssname sset j)))
    (setq j (1+ j))
    (if (= (cdr(assoc 68 temp)) 2)
      (setq vp temp)
    )
    (if (= (cdr(assoc 69 temp)) num)
      (setq cont nil
            vp   temp
      )
    )
  )
  (cdr(assoc 69 vp))
)
;;;
;;; Align viewport geometry
;;;
;;; mv_vpa == MView_ViewPort_Align
;;;