mvsetup.lsp

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

(defun mv_vpa ( / temp temp1 ans p1 pt1 p2 a1 d1)
  (setq temp T)
  (while temp
    (initget "Angled Horizontal Rotate Vertical Undo")
    (setq ans (getkword 
      "\nEnter an option [Angled/Horizontal/Vertical alignment/Rotate view/Undo]: "))
    (if (or (= ans "") (= ans "Rotate") (= ans "Undo") (null ans))
      (if (= ans "Rotate")
        (progn
	  (command "_.UNDO" "_GROUP")
	  (setq uctr (1+ uctr))
          (command "_.MSPACE")
          (command "_.UCS" "_W")
          (setq p1 (getpoint "\nSpecify basepoint in the viewport with the view to be rotated: "))
          (setq temp (getvar "cvport"))
          (command "_.UCS" "_V")
          (setq a1 (getangle (trans p1 0 1) "\nSpecify angle from basepoint: "))
          (command "_.DVIEW" ""  "_TW" (* a1 (/ 180 pi)) "")
          (command "_.UCS" "_P")
          (command "_.UCS" "_P")
          (command "_.PSPACE")
	  (command "_.UNDO" "_EN")
        )
        (if (= ans "Undo")
          (cond
            ((= uctr 0) (princ "\nNothing to undo. \n") )
            ((> uctr 0) 
              (command "_.U")
              (setq uctr   (- uctr 1)
                    ll_crn nil
            )
            )
          ) 
          (setq temp nil)
        )
      )
      (progn
        (command "_.UNDO" "_GROUP")
        (setq uctr (1+ uctr))
        (command "_.MSPACE")
        (command "_.UCS" "_W")
        (setq p1 (getpoint "\nSpecify basepoint: "))
        (setq pt1 (trans (trans p1 1 2) 2 3))
        (setq temp (getvar "cvport"))
        
        (setq p2 (getpoint "\nSpecify point in viewport to be panned: "))
        (setq p2 (trans (trans p2 1 2) 2 3))
        (cond 
          ((= ans "Angled")
            (setq temp1 (getvar "cvport"))
            (if (= temp1 temp)
              (princ "\nPoints must be in different viewports. ")
              (progn
                (setvar "cvport" temp) 
                (setvar "orthomode" 0) 
                (princ (strcat
                  "\nSpecify the distance and angle "
                  "to the new alignment point "))  
                (princ (strcat
                  "\nin the current viewport where "
                  "you specified the basepoint. "))
                (setq d1 (getdist "\nSpecify distance from basepoint: "))
                (setq a1 (getangle "\nSpecify angle from basepoint: "))
                (setq p1 (polar p1 a1 d1))
                (setq p1 (trans (trans p1 1 2) 2 3))
                (setvar "cvport" temp1) 
                (command "_.UCS" "_V")
                (command "_.PAN" (trans p2 3 2) (trans p1 3 2))
              )
            )
          )
          ((= ans "Horizontal")
            (setq temp1 (getvar "cvport"))
            (command "_.UCS" "_V")
            (setq p1 (list (car p2) (cadr pt1) (caddr p2)))
            (if (= temp1 temp)
              (princ "\nPoints must be in different viewports. ")
              (command "_.PAN" (trans p2 3 2) (trans p1 3 2))
            )
          )
          ((= ans "Vertical")
            (setq temp1 (getvar "cvport"))
            (command "_.UCS" "_V")
            (setq p1 (list (car pt1) (cadr p2) (caddr p2)))
            (if (= temp1 temp)
              (princ "\nPoints must be in different viewports. ")
              (command "_.PAN" (trans p2 3 2) (trans p1 3 2))
            )
          )
          (T
            (setq temp nil)
          )
        )
        (command "_.UCS" "_P")
        (command "_.UNDO" "_EN")
      )
    )
  )
)
;;;
;;; Read lines from a file until the argument matches the given sub-string
;;;
;;; mv_rux == MView_Read_Until_Xx_found
;;;
(defun mv_rux (str j k / l cont line)
  (setq cont T l 1)
  (while cont
    (setq line (read-line deffi))
    (setq l (1+ l))
    ;; Seek to the first instance of str at position j - k.
    (if line
      (if (= (substr line j k) str)
        (setq cont nil)
      )
      (progn
        (setq cont nil l nil)
      )
    )
  )
  l                                   ; Return nil or line number where 
                                      ; matching string is found
)
;;;
;;; Tokenize the line, removing any blanks not within the string.
;;; Return the tokenized list of strings found.
;;;
;;; mv_tok == MView_TOKenize
;;;
(defun mv_tok (str / sl j str_list)
  (setq s_list (mv_tkw str))
  (setq list_l (length s_list)
        j      0
  )
  (while (< j list_l)
    (setq s_list (subst (mv_tki (nth j s_list)) (nth j s_list) s_list))
    (setq j (1+ j))
  )
  s_list
)
;;;
;;; Tokenize the item, removing any leading and trailing blanks.
;;; Return the string.
;;;
;;; mv_tki == MView_ToKenize_Item
;;;
(defun mv_tki (str / sl j k str_list)
  (setq sl (strlen str)
        j  1
        k  0
  )
  (while (and (< j sl) (= (substr str j 1) " "))
    (setq j (1+ j))
  )
  (while (and (< k sl) (= (substr str (- sl k) 1) " "))
    (setq k (1+ k))
  )
  (substr str j (- sl k))
)
;;;
;;; Tokenize a string into a list of strings.
;;; Return the tokenized string list.
;;;
;;; mv_tkw == MView_ToKenize_into_Words
;;;
(defun mv_tkw (str / sl k)
  (setq sl (strlen str)
        k  0
  )
  (while (and (< k sl) (/= (substr str (1+ k) 1) ","))
    (setq k (1+ k))
  )
  (if str_list 
    (setq str_list (append str_list (list (substr str 1 k))))
    (setq str_list (list (substr str 1 k)))
  )
  (setq k (+ k 2))
  (if (< k sl)
    (mv_tkw (substr str k))
  )
  str_list
)
;;;
;;; List names on the screen until an end of list marker is found.
;;; Store the items found into a list, ITEM_LIST, a global
;;; Ignore blank lines and commented lines. Return number of lines.
;;;
;;; mv_lns == MView_List_Names_on_Screen
;;;
(defun mv_lns (str j k / l cont line)
  (setq cont T l -1)
  (while cont
    (if (setq line (read-line deffi))
      ;; Seek to the end of the section delimited by "str"
      ;; Else print the line to the screen preceded by an integer
      (if (= (substr line j k) str)
        (setq cont nil)
        (progn
          (setq l         (1+ l)
                new_line  (mv_tok line)
                item      (car new_line)
                ITEM_LIST (if ITEM_LIST
                            (append ITEM_LIST (list new_line))
                            (list new_line)
                          )
          )
          (if (and (= (rem l 10) 1) (> l 1))
            (if (= (rem l 20) 1)
              (progn
                (princ "\n<more> ")
                (grread)
              )
              (terpri)
            )
          )
          (princ (strcat "\n\t" (itoa l) ":\t " item))
        )
      )
      (setq cont nil)
    )
  )
  l
)
;;;
;;; Add an entry to the default file.  Get all inputs.
;;;
;;; mv_aef == MView_Add_an_Entry_to_default_File
;;;
(defun mv_aef ( / str ans deffo p1 p2)
  (setq ans (getstring T "\nEnter title block description: "))
  (if (not (or (= ans "") (null ans))) 
    (progn
      (setq str ans)
      (setq ans (getstring "\nEnter drawing name to insert (without extension): "))
      (if (not (or (= ans "") (null ans))) 
        (progn
          (initget "Yes No")
          (setq p1 (getkword "\nDefine default usable area? [Yes/No] <Y>: "))
          (if (= p1 "No")
            (setq str (strcat str "," ans ".dwg" "," mv_utr))
            (progn
              (initget 1)
              (setq p1 (getpoint "\nSpecify lower-left corner: "))
              (initget 1)
              (setq p2 (getcorner p1 "\nSpecify upper-right corner: "))
              (mv_s2p 'p1 'p2)
              (setq str (strcat str "," ans ".dwg" 
                                ",(" (rtos (car p1))
                                " " (rtos (cadr p1))
                                " " (rtos (caddr p1))
                                ")"
                                ",(" (rtos (car p2))
                                " " (rtos (cadr p2))
                                " " (rtos (caddr p2))
                                ")"
                                "," mv_utr))
            )
          )
          (setq deffi (close deffi))
          (if (setq deffi (mv_lfx mv_xdf "r"))
            (if (setq deffo (mv_lfx "temp.tdf" "w"))
              (progn
                (setq cur_ln (+ cur_ln max_l))
                (repeat cur_ln (progn
                  (write-line (read-line deffi) deffo)
                ))
                (write-line str deffo)
                (while (setq line (read-line deffi))
                  (write-line line deffo)
                )
              )
            )
          )
          (setq deffo (close deffo))
          (setq deffi (close deffi))
          (if (setq deffi (mv_lfx "temp.tdf" "r"))
            (if (setq deffo (mv_lfx mv_xdf "w"))
              (while (setq line (read-line deffi))
                (write-line line deffo)
              )
            )
          )
          (setq deffo (close deffo))
          (setq deffi (close deffi))
		  (command "shell" "del temp.tdf")          
          (textpage)
        )
      )
    )
  )
)
;;;
;;; Subtract an entry from the default file.  Get all inputs.
;;;
;;; mv_sef == MView_Subtract_an_Entry_from_default_File
;;;
(defun mv_sef ( / str ans deffo)
  (setq str (nth 0 d_item_list))
  (setq deffi (close deffi))
  (if (setq deffi (mv_lfx mv_xdf "r"))
    (if (setq deffo (mv_lfx "temp.tdf" "w"))
      (progn
        (setq cur_ln (mv_rux str 1 (strlen str)))
        (setq cur_ln (- cur_ln 2))
        (close deffi)
        (setq deffi (mv_lfx mv_xdf "r"))

        (repeat cur_ln (progn
          (write-line (read-line deffi) deffo)
        ))
        (read-line deffi)
        (while (setq line (read-line deffi))
          (write-line line deffo)
        )
      )
    )
  )
  (setq deffo (close deffo))
  (setq deffi (close deffi))
  (if (setq deffi (mv_lfx "temp.tdf" "r"))
    (if (setq deffo (mv_lfx mv_xdf "w"))
      (while (setq line (read-line deffi))
        (write-line line deffo)
      )
    )
  )
  (setq deffo (close deffo))
  (setq deffi (close deffi))  
  (command "shell" "del temp.tdf")
  (textpage)
  (setq deffi (mv_lfx mv_xdf "r"))

  (princ)
)
;;;
;;; Pick from the list by typing an integer, returns the item or zero.
;;; cont is global to this routine, local to the calling routine.
;;;
;;; mv_pfl == MView_Pick_From_List
;;;
(defun mv_pfl (max_l ig_b ig_str prmpt / OK ans return str)
  (while (null OK)
    (initget ig_b ig_str)
    (setq ans (getint prmpt))
    (cond 
      ((or (= ans "") (null ans))
        (setq OK T cont nil return 0)
      )
      ((= ans "Add")
        (mv_aef)
        (setq OK T)
      )
      ((= ans "Delete")
        (setq str "\nEnter number of entry to delete from list: ")
        (setq d_item_list (mv_pfl max_l 6 "" str))
        (if d_item_list
          (progn
            (princ (strcat "\nDeleting " (car d_item_list) " from list. "))
            (mv_sef)
          )
        )
        (setq OK T cont T return 0)
      )
      ((= ans "Redisplay")
        (setq OK T)
      )
      (T
        (if (and (>= ans 0) (<= ans max_l))
          (setq return (nth ans ITEM_LIST)
                OK     T
                cont   nil
          )
          (progn
            (princ (strcat 
              "\nNumber must be between 0 and " (itoa max_l) "\n"))
            (setq OK nil)
          )
        )
      )
    )
  )  
  return
)
;;;
;;; Get the user's options
;;;
;;; mv_gop == MView_Get_OPtions
;;;
(defun mv_gop (/ deffi d_item_name max_lines ans cont isc fsc mmsc msc li ll)
  (if (setq deffi (mv_lfx mv_xdf "r"))
    (progn
      
      (textpage)
      (setq str1 "\nAvailable title blocks:... \n")
      
      (setq d_item_list (mv_pao "NAMES" str1))
      (if (and (= (type d_item_list) 'LIST) (null skip))
        (progn
          (mv_tbi)
          (setq ll (length d_item_list)
                li (nth 2 d_item_list)
          )
          (if li                      ; ll is > 2
            (progn
              (if (= (type (read li)) 'LIST)
                (progn
                  (setq ll_crn li)