[编程交流] 绘图反应堆

; Change plot scale based on papersize
(defun c:changeScale (/ actLay papSize)
 (setq actLay (vla-get-activelayout (vla-get-activedocument 
                                                  (vlax-get-acad-object)))
   papSize (vla-get-CanonicalMediaName actLay))
 (Cond ((eq papSize "A1")
    (vla-put-StandardScale actLay acVpCustomScale)
    (vla-setcustomscale actLay 1 2500)
    )
   ((eq papSize "A3")
    (vla-put-StandardScale actLay acVpCustomScale)
    (vla-setcustomscale actLay 1 1250)
    )
   )
 )

;;; ------------------------------------------------------------------------
;;;    PlotSheetScaleReactor.lsp v1.0
;;;    (PlotSheetCountReactor modified by SK)
;;;
;;;    Copyright© 10.02.09
;;;    Alan J. Thompson (alanjt)
;;;    alanjt
;;;
;;;    Permission to use, copy, modify, and distribute this software
;;;    for any purpose and without fee is hereby granted, provided
;;;    that the above copyright notice appears in all copies and
;;;    that both that copyright notice and the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;;
;;;    The following program(s) are provided "as is" and with all faults.
;;;    Alan J. Thompson DOES NOT warrant that the operation of the program(s)
;;;    will be uninterrupted and/or error free.
;;;
;;;
;;;    Revision History:
;;;
;;; ------------------------------------------------------------------------
(vl-load-com)
;; activate reactor
(or PlotSheetScale:Reactor
   (setq PlotSheetScale:Reactor
          (vlr-command-reactor
            nil
            '((:vlr-commandWillStart . PlotSheetScale:Procedure)
             )
          ) ;_ vlr-command-reactor
   ) ;_ setq
) ;_ or
;; procedure
(defun PlotSheetScale:Procedure (#Call #Info / actLay papSize)
 (cond
   ((wcmatch (strcase (car #Info)) "*PLOT*")
    (setq actLay (vla-get-activelayout (vla-get-activedocument
                     (vlax-get-acad-object)))
      papSize (vla-get-CanonicalMediaName actLay))
    (Cond ((eq papSize "A1")
       (vla-put-StandardScale actLay acVpCustomScale)
       (vla-setcustomscale actLay 1 2500)
       )
      ((eq papSize "A3")
       (vla-put-StandardScale actLay acVpCustomScale)
       (vla-setcustomscale actLay 1 1250)
       )
      )
    )
 ) ;_ cond
) ;_ defun