[编程交流] 帮助：将缩放到的LISP

(defun c:setcurrentviewtoalldwgs ( / v c uo ux uy vd pe )
 (setq v (getvar 'viewsize) c (getvar 'viewctr))
 (setq uo (trans '(0.0 0.0 0.0) 1 0))
 (setq ux (trans '(1.0 0.0 0.0) 1 0))
 (setq uy (trans '(0.0 1.0 0.0) 1 0))
 (if (eq (getvar 'cvport) 1)
   (progn
     (mapcar 'vl-propagate (list 'v 'c 'uo 'ux 'uy))
     (setq fn (open "c:/processdoc.lsp" "w"))
     (write-line "(vl-load-com)" fn)
     (write-line "(setq d (vla-get-activedocument (vlax-get-acad-object)))" fn)
     (write-line "(vla-regen d acactiveviewport)" fn)
     (write-line "(if" fn)
     (write-line "(not" fn)
     (write-line "(and" fn)
     (write-line "(equal uo '(0.0 0.0 0.0))" fn)
     (write-line "(equal ux '(1.0 0.0 0.0))" fn)
     (write-line "(equal uy '(0.0 1.0 0.0))" fn)
     (write-line ")" fn)
     (write-line ")" fn)
     (write-line "(progn" fn)
     (write-line "(setq ucs (vla-add (vla-get-usercoordinatesystems d) (vlax-3d-point uo) (vlax-3d-point ux) (vlax-3d-point uy) "{ UCS }"))" fn)
     (write-line "(vla-put-activeucs d ucs)" fn)
     (write-line "(command "_.UCS" "_W")" fn)
     (write-line "(vla-delete ucs)" fn)
     (write-line "(command "_.UCS" "_P")" fn)
     (write-line ")" fn)
     (write-line "(command "_.UCS" "_W")" fn)
     (write-line ")" fn)
     (write-line "(command "_.ZOOM" "_C" c v)" fn)
     (write-line "(if ucs (setq ucs nil))" fn)
     (write-line "(if d (setq d nil))" fn)
     (write-line "(mapcar '(lambda ( x ) (set x nil)) (list 'v 'c 'uo 'ux 'uy))" fn)
     (write-line "(princ)" fn)
     (close fn)
   )
   (progn
     (setq vd (trans (getvar 'viewdir) 1 0 t))
     (setq pe (getvar 'perspective))
     (mapcar 'vl-propagate (list 'v 'c 'uo 'ux 'uy 'vd 'pe))
     (setq fn (open "c:/processdoc.lsp" "w"))
     (write-line "(vl-load-com)" fn)
     (write-line "(setq d (vla-get-activedocument (vlax-get-acad-object)))" fn)
     (write-line "(command "_.DVIEW" "" "_PO" "0,0,0" vd "")" fn)
     (write-line "(vla-regen d acactiveviewport)" fn)
     (write-line "(if" fn)
     (write-line "(not" fn)
     (write-line "(and" fn)
     (write-line "(equal uo '(0.0 0.0 0.0))" fn)
     (write-line "(equal ux '(1.0 0.0 0.0))" fn)
     (write-line "(equal uy '(0.0 1.0 0.0))" fn)
     (write-line ")" fn)
     (write-line ")" fn)
     (write-line "(progn" fn)
     (write-line "(setq ucs (vla-add (vla-get-usercoordinatesystems d) (vlax-3d-point uo) (vlax-3d-point ux) (vlax-3d-point uy) "{ UCS }"))" fn)
     (write-line "(vla-put-activeucs d ucs)" fn)
     (write-line "(command "_.UCS" "_W")" fn)
     (write-line "(vla-delete ucs)" fn)
     (write-line "(command "_.UCS" "_P")" fn)
     (write-line ")" fn)
     (write-line "(command "_.UCS" "_W")" fn)
     (write-line ")" fn)
     (write-line "(command "_.ZOOM" "_C" c v)" fn)
     (write-line "(setvar 'perspective pe)" fn)
     (write-line "(if ucs (setq ucs nil))" fn)
     (write-line "(if d (setq d nil))" fn)
     (write-line "(mapcar '(lambda ( x ) (set x nil)) (list 'v 'c 'uo 'ux 'uy 'vd 'pe))" fn)
     (write-line "(command "_.-PURGE" "_B" "DVIEWBLOCK" "_N")" fn)
     (write-line "(princ)" fn)
     (close fn)
   )
 )
 (prompt "\nSwitch to each opened DWG, and type (load "c:/processdoc.lsp") and when finished return to master DWG and type (vl-file-delete "c:/processdoc.lsp")")
 (textscr)
 (princ)
)
(defun c:scvtad nil (c:setcurrentviewtoalldwgs))

(setq var "Banana Cake")
(vl-propagate 'var)

(defun c:dew ()
     (if (or OneCorner (setq OneCorner (getpoint "\nPick Lower left corner")))
             (progn (command "_Zoom" "_Window" "_non" OneCorner "_non"
                     (if OtherCorner OtherCorner
                   (setq OtherCorner (getcorner OneCorner "\nSpecify opposite corner:"))))
                     (vl-propagate 'OneCorner)
               (vl-propagate 'OtherCorner))))
     
(Defun c:rdew ()
     (setq OneCorner nil
           OtherCorner nil)
     (c:dew)
     )