Автоматическая печать нескольких узлов с заданным набором параметров (VBA)

;---------------------------------------------------------------
(defun Landscape (ll ur)
(command "-PLOT"
     "YES"    ;Detailed plot configuration?
     ""        ;Enter a layout name or [?] <Model>:
     "Canon LBP-4" ; printer name
     "A4"
     "Millimeters"
     "Landscape"
     "N"    ;Plot upside down?
     "WINDOW" ll ur    ; Lower left and Upper right corner of plot window
     "FIT"   ;(Plotted Millimeters=Drawing Units) OR [Fit]
     "CENTER"    ;Enter plot offset (x,y) or [Center]
     "YES"    ;Plot with plot styles
     "MONOCHROME"    ;plot style table name
     "YES"    ;PLOT WITH LIGHWEIGHT
     "As displayed" ;SHADE PLOT SETTING
     "N"        ;Write the plot to a file [Yes/No] <N>:
     "Y" ;Save changes to page setup [Yes/No]? <N> y
     "Y" ;Proceed with plot [Yes/No] <Y>:
     );END command
  )
;------------------------------------------------------------------
(defun Portrait (ll ur)
(command "-PLOT"
     "YES"    ;Detailed plot configuration?
     ""        ;Enter a layout name or [?] <Model>:
     "Canon LBP-4" ; printer name
     "A4"
     "Millimeters"
     "Portrait"
     "N"    ;Plot upside down?
     "WINDOW" ll ur    ; Lower left and Upper right corner of plot window
     "FIT"   ;(Plotted Millimeters=Drawing Units) OR [Fit]
     "CENTER"    ;Enter plot offset (x,y) or [Center]
     "YES"    ;Plot with plot styles
     "MONOCHROME"    ;plot style table name
     "YES"    ;PLOT WITH LIGHWEIGHT
     "As displayed" ;SHADE PLOT SETTING
     "N"        ;Write the plot to a file [Yes/No] <N>:
     "Y" ;Save changes to page setup [Yes/No]? <N> y
     "Y" ;Proceed with plot [Yes/No] <Y>:
     );END comman
  )
;-------------------------------------------------------------------
(defun test-plot-by-wdw (/ adoc blocks lowleft
             ss uppright vset)
  (vl-load-com)
  (setq    adoc (vla-get-activedocument
           (vlax-get-acad-object)
         )
  )
  (if
  (setq vset (vla-get-activeselectionset adoc))
  (progn
  (vla-clear vset)(vla-delete vset))
  (setq blocks (vla-get-blocks adoc)))
(setq plot_list nil)
(setq ss (ssget "_X"     '((0 . "LWPOLYLINE")
          (8 . "KHUNGTEN"))));[b] KHUNGTEN - название уникального слоя на котором начерчены только рамки[/b]
(setq vset (vla-get-activeselectionset adoc))
(vlax-for a
      vset
  (vla-getboundingbox a 'lowleft 'uppright)
  (cond ((> (abs (- (car (vlax-safearray->list lowleft))
      (car (vlax-safearray->list uppright))))
         (abs (- (cadr (vlax-safearray->list lowleft))
      (cadr (vlax-safearray->list uppright)))))
     (setq plot_list (cons (cons "Landscape"
        (list (vlax-safearray->list lowleft)
            (vlax-safearray->list uppright)))
              plot_list)))
    
    ((> (abs (- (cadr (vlax-safearray->list lowleft))
      (cadr (vlax-safearray->list uppright))))
         (abs (- (car (vlax-safearray->list lowleft))
      (car (vlax-safearray->list uppright)))))
     (setq plot_list (cons (cons "Portrait"
        (list (vlax-safearray->list lowleft)
                (vlax-safearray->list uppright)))
              plot_list)))
    
    (T nil)))
  (setq ss nil)
  (vla-delete vset)
  plot_list
  )
;;Call:
;;;(test-plot-by-wdw)
;                            ;
(defun plot-order (plot_list  char     /        cell_diff
           cell_height         cell_length
           elist      en     i        lbd
           lwr          new_plot_list        number
           rbd          ss     stamp_diff upl
          )
[b]  ;; координаты ячейки штампа где стоит номер листа, для наших стандартов - другие размеры, измени сам[/b]
  (setq    cell_length
     3000.
    cell_height
     500.
    stamp_diff
     1500.
    cell_diff 1500.
  )
  (foreach w plot_list
    (setq lbd (cadr w)
      rbd (caddr w)
    )
    (setq upl (list (- (car rbd) stamp_diff)
            (+ (cadr lbd) stamp_diff cell_diff)
            (caddr lbd)
          )
    )
    (setq lwr (list (- (car upl) cell_length)
            (+ (cadr upl) cell_height)
            (caddr upl)
          )
    )
    (setq ss (ssget "_W" upl lwr '((0 . "TEXT"))))
    (setq i -1)
    (repeat (sslength ss)
      (setq i (1+ i))
      (setq en      (ssname ss i)
        elist (entget en)
      )
      (if (vl-string-search char (cdr (assoc 1 elist)))
    (progn
      (setq    number
         (atoi (vl-string-left-trim char (cdr (assoc 1 elist)))
         )
      )
      (setq w (append (list number) w))
      (setq new_plot_list (cons w new_plot_list))
      (setq    ss nil
        i  nil
      )
    )
      )
    )
  )
  (setq    new_plot_list
     (vl-sort new_plot_list
          (function (lambda (a1 a2)
                  (< (car a1) (car a2))
                )
          )
     )
  )
  (setq new_plot_list (mapcar 'cdr new_plot_list))
;;;  new_plot_list
)
;;;TesT:
;;;(plot-order (test-plot-by-wdw))
;-------------------------------------------------------------------
(defun test-plot-from-list (lst) ;[v.1]
(foreach w plot_list
  (cond ((eq (car w) "Landscape")(Landscape (cadr w) (caddr w)))
    ((eq (car w) "Portrait")(Portrait (cadr w)(caddr w)))
    (T nil)))
  (princ)
  )
;;Call:(test-plot-from-list plot_list)
;;;(defun  test-plot-from-list (lst) ;[v.2]
;;;(foreach w lst
;;;  (if (not (vl-catch-all-error-p
;;;         (vl-catch-all-apply (function (lambda ()
;;;  (vla-setwindowtoplot
;;;  (vla-get-activelayout adoc)
;;;  (vlax-3d-point (cadr lst))
;;;  (vlax-3d-point (caddr lst))))))))
;;;
;;;  (vl-catch-all-apply (function (lambda ()
;;;  (vla-plottodevice
;;;  (vla-get-plot adoc) "Default System Printer")))))
;;; )
;;;(princ)
;;;)
 (defun    def-plot-sheets    (plot_list / sheet_list)
   (setq answer
      (getstring
        "\nEnter numbers of sheets as with comma\n
   \nor touch delimeted numbers\n\t:"
      )
   )
   (if answer
     (progn
       (cond ((vl-string-search "," answer)
          (while (vl-string-search "," answer)
        (setq answer (vl-string-subst (chr 32) "," answer))
          )
          (setq sheet_list (reverse (read (strcat "(" answer ")"))))
         )
         ((vl-string-search "-" answer)
          (setq tmp      (read
                (strcat "(" (vl-string-subst (chr 32) "-" answer) ")")
              )
            start (car tmp)
            end      (cadr tmp)
          )
          (while (<= start end)
        (setq sheet_list (cons start sheet_list))
        (setq start (1+ start))
          )
         )
         (T (alert "\nWrong numbers entering!\n"))
       )
     )
   )
   (if (> (apply 'max sheet_list) (length plot_list))
     (alert
       "\nThis number of sheet
   \nin plot list not found"
     )
     (setq plot_list (mapcar (function (lambda (x)
                     (nth (1- x) plot_list)
                       )
                 )
                 (reverse sheet_list)
             )
     )
   )
 )
    
;Call:
;;;(def-plot-sheets plot_list);ok
;-------------------------------------------------------------------
(defun C:PCT (/ plot_list char)
(command "._zoom" "_e")
[b];; ввод номеров листов на печать через запятую или дефис:[/b]
  (alert
  "\nRULE OF ENTERING correct sheet numbers:
  \nFirst method like this: 1,17,52,98,99,100
  \without blank spaces between numbers
  \nSecond method like this: 22-45 or 1-100\n
  \! *DO NOT MIX BOTH METHODS* !")
 (setq char "kt-"); [b]kt - префикс нумерации листов, двойные кавычки ("") если префикса нет, замени здесь[/b]
 (if char
 (progn
 (if (setq plot_list (test-plot-by-wdw))
  (test-plot-from-list
    (plot-order (def-plot-sheets plot_list) char))
  (alert "\nSomething wrong!\n"))
  ))
  (print plot_list)
  (princ)
)
(vl-load-com)
(C:PCT) ; автозапуск
(princ)
;-------------------------------------------------------------------