Печать множества листов

вместо тысячи слов. лисп сам создаст нужное количество листов нужным масштабом по рамкам.

Код:

;;; AddLay
;;; Создание листов и видовых экранов
(defun C:AL (/
 ActiveDocument
 Application
 Display
 DeleteLayouts
 FirstSheet
 Flag
 Formats
 i
 j
 Layout
 Layouts
 Layer
 ModelSpace
 NumberFormats
 PaperSpace
 Points
 MatchSheet
 MinPoint
 MaxPoint
 NoMatchSheet
 Object
 Point1
 Point2
 Point1x
 Point1y
 Point2x
 Point2y
 Scale
 Square
 ViewportHight
 ViewportWidth
 Viewport
 X
 Y
 )
  (vl-load-com) ; Загрузка функций ActiveX
  (setvar "CTAB" "Model") ; Переход во вкладку модели
  (initget 6)
  (setq Application (vlax-get-acad-object) ; Указатель приложения
ActiveDocument (vla-get-ActiveDocument Application) ; Указатель активного документа
ModelSpace (vla-get-ModelSpace ActiveDocument) ; Указатель пространства модели
;PaperSpace (vla-get-PaperSpace ActiveDocument) ; Указатель пространства листа
Layouts (vla-get-Layouts ActiveDocument) ; Указатель семейства листов
Display (vla-get-Display (vla-get-Preferences (vlax-get-acad-object))) ; Указатель экранных настроек
;Layer (getstring T "Введите имя слоя с рамками:") ; Запрос имени слоя с форматами путём ввода имени слоя
)
  ;;; Запрос слоя с форматами указанием объекта на нужном слое
  (while (null Object)
    (setq Object (car (entsel "Укажите объект для определения слоя с рамками")))
    )
  (setq Layer (cdr (assoc 8 (entget Object))) ; Определение слоя с форматами
Formats (ssget (list (cons 8 Layer))) ; Создание набора форматов
NumberFormats (sslength Formats) ; Длина набора форматов
Scale (getreal "Масштаб 1:<1>") ; Запрос масштаба
i 0
Points ()
)
  (if (not Scale) (setq Scale 1))
  (repeat NumberFormats (ssname Formats i)
    (setq Format (vlax-ename->vla-object (ssname Formats i)))
    (if
      (and (= (vla-get-ObjectName Format) "AcDbBlockReference") (= (vla-get-IsDynamicBlock Format) :vlax-true)) ; Проверка: является ли рамка динамическим блоком
      (progn
(GetBoundingBox_dynblock (vlax-vla-object->ename Format)) ; Получение точек рамок формата, если рамка является динамическим блоком
(setq
  Points (append Points (list (GetBoundingBox_dynblock (vlax-vla-object->ename Format)))) ; Заполнение списка точками
  i (1+ i)
  )
)
      (progn
(vla-GetBoundingBox (vlax-ename->vla-object (ssname Formats i)) 'MinPoint 'MaxPoint) ; Получение точек рамок формата, если рамка не является динамическим блоком
(setq
  Points (append Points (list (list (vlax-safearray->list MinPoint)  (vlax-safearray->list MaxPoint)))) ; Заполнение списка точками
  i (1+ i)
  )
)
      )
    )
  ;;; Определения порядка сортировки точек
  (setq i 0)
  (repeat (length Points) ; Создание списка координат X и Y
    (setq X (append X (list (caar (nth i Points)))))
    (setq Y (append Y (list (cadar (nth i Points)))))
    (setq i (1+ i))
    )
  (if
    (> (- (MaxElement X) (MinElement X)) (- (MaxElement Y) (MinElement Y))) ; Условие выбора способа сортировки
    (setq Points (vl-sort Points (function (lambda (Points1 Points2) (< (caar Points1) (caar Points2)))))) ; Сортировка точек по X координате
    (setq Points (vl-sort Points (function (lambda (Points1 Points2) (> (cadar Points1) (cadar Points2)))))) ; Сортировка точек по Y координате
    )
  ;;; Отключение автоматического создания видовых экранов на новых листах
  (if
    (= (vla-get-LayoutCreateViewport Display) :vlax-true) ; Проверка пользовательской настройки
    (progn
      (vla-put-LayoutCreateViewport Display :vlax-false) ; Отключение автоматического создания видового экрана
      (setq Flag T)
      )
    )
  ;;; Работа с листами
  (initget 1 "Да Нет")
  (setq DeleteLayouts (getkword "Удалить существующие листы? [Да/Нет]: ")) ; Запрос удаления листов
  (cond
    (
     (= DeleteLayouts "Да")
     ;;; Удаление существующих листов
     (vlax-for Layout Layouts
       (if
 (/= (vla-get-Name Layout) "Model")
 (vla-delete Layout)
 )
       )
     (initget 6)
     (setq FirstSheet (getint "Начальный номер листа:")) ; Запрос номера первого листа
     (vla-put-Name (vla-Item Layouts 1) (itoa FirstSheet)) ; Переименование первого листа
     )   
    ;;; Работа с добавляемыми листами
    (
     (= DeleteLayouts "Нет")
     (while (= NoMatchSheet nil)
       (progn
 (initget 6)
 (setq
   i 0
   FirstSheet (getint "Начальный номер листа:") ; Запрос номера первого листа
   MatchSheet nil
   )
 (repeat NumberFormats
   (if
     (not (null (member (itoa (+ FirstSheet i)) (layoutlist)))) ; Проверка на совпадение
     (setq MatchSheet T)
     )
   (setq i (1+ i))
   )
 (if
   (= MatchSheet T)
   (alert "Совпадение имён листов!") ; Предупреждение о совпадении
   (setq NoMatchSheet T)
   )
 )
       )
     )
    )
  ;;; Вставка новых листов
  ;(setq i 1
  (setq i 0
j 0
)
  (repeat NumberFormats
    (cond
      ;;; Вставка при удалении
      (
       (= DeleteLayouts "Да")
       (if
 (= i 0)
 (progn
   (setq Layout (vla-item Layouts 0))
   ;(setvar "CTAB" "1")
   (setvar "CTAB" (itoa FirstSheet))
   )
 (progn
   ;(setq Layout (vla-Add Layouts (itoa i)))
   (setq Layout (vla-Add Layouts (itoa (+ FirstSheet i))))
   ;(setvar "CTAB" (itoa i))
   (setvar "CTAB" (itoa (+ FirstSheet i)))
   )
 )
       )
      (
       ;;; Вставка без удаления
       (= DeleteLayouts "Нет")
       (progn
 ;(setq Layout (vla-Add Layouts (itoa (+ FirstSheet (1- i)))))
 (setq Layout (vla-Add Layouts (itoa (+ FirstSheet i))))
 ;(setvar "CTAB" (itoa (+ FirstSheet (1- i))))
 (setvar "CTAB" (itoa (+ FirstSheet i)))
 )
       )
      )
    ;;; Создание видовых экранов на листах
    (setq Point1 (car (nth j Points))
  Point2 (cadr (nth j Points))
  PaperSpace (vla-get-paperspace ActiveDocument)
  Point1x (car Point1) ; Получение координат из точек
  Point1y (cadr Point1)
  Point2x (car Point2)
  Point2y (cadr Point2)
  ViewportHight (/ (abs (- Point1y Point2y)) Scale) ; Получение высоты видового экрана
  ViewportWidth (/ (abs (- Point1x Point2x)) Scale) ; Получение ширины видового экрана
  Viewport (vla-AddPViewport PaperSpace (vlax-3d-point (list (/ ViewportWidth 2) (/ ViewportHight 2))) ViewportWidth ViewportHight)) ; Видовой экран
    (vla-display Viewport :vlax-true)
    (vla-put-mspace ActiveDocument :vlax-true) ; Активизация модели в видовом экране
    (vla-zoomcenter Application (vlax-3d-point (list (/ (+ Point1x Point2x) 2) (/ (+ Point1y Point2y) 2))) 1.0) ; Центровка зума экрана
    (vla-put-mspace ActiveDocument :vlax-false) ; Деактивация пространства модели
    (vla-put-standardscale Viewport acVpCustomScale) ; Установка пользовательского масштаба видового экрана
    ;(vla-put-CustomScale Viewport 1.0) ; Установка масштаба видового экрана
    (vla-put-CustomScale Viewport (/ (float 1) (float Scale))) ; Установка масштаба видового экрана
    (vla-put-DisplayLocked Viewport "-1") ; Блокировка видового экрана
    ;;; Установка параметров печати
    (vla-put-StyleSheet Layout "acad.ctb") ; Установка таблицы стилей печати
    (vla-put-PlotType Layout 5) ; Установки области печати "Лист"
    ;;; Установка форматов листа
    (setq Square (* ViewportHight ViewportWidth)) ; Расчёт площади видового экрана
    (cond ; Выбор формата в зависимости от площади видового экрана
      ((and (> Square 59251) (< Square 65488)) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "ISO_full_bleed_A4_(297.00_x_210.00_MM)"))
      ((and (> Square 118503) (< Square 130977)) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "ISO_full_bleed_A3_(420.00_x_297.00_MM)"))
      ((and (> Square 237006) (< Square 261954)) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "ISO_full_bleed_A2_(594.00_x_420.00_MM)"))
      ((and (> Square 474012) (< Square 523908)) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "ISO_full_bleed_A1_(841.00_x_594.00_MM)"))
      ((and (> Square 948024) (< Square 1047816)) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "ISO_full_bleed_A0_(841.00_x_1189.00_MM)"))
      ((or ; Установка пустого устройства печати для нестандартных форматов листа
 (< Square 59251)
 (and (> Square 65488) (< Square 118503))
 (and (> Square 130977) (< Square 237006))
 (and (> Square 261954) (< Square 474012))
 (and (> Square 523908) (< Square 948024))
 (> Square 1047816)
 )
       (vla-put-ConfigName Layout "Нет")
       )
      )
    (if (> ViewportHight ViewportWidth) (vla-put-PlotRotation Layout 1) (vla-put-PlotRotation Layout 0)) ; Установка ориентации листа
    (command "_Zoom" "_All") ; Зумирование листа
    (setq i (1+ i))
    (setq j (1+ j))
    )
  ;;; Включение автоматического создания видового экрана на новом листе, если таковое было предусмотрено пользователем
  (if
    (= Flag T)
    (vla-put-LayoutCreateViewport Display :vlax-true)
    )
  (setvar "CTAB" "Model") ; Переключение на вкладку "Модель"
  )
 
;;; Функция нахождения минимального элемента из списка
(defun MinElement (X /) (car (vl-sort X '<)))
 
;;; Функция нахождения максимального элемента из списка
(defun MaxElement (X /) (car (vl-sort X '>)))
 
;;; Функция определения границ рамки формата для динамического блока
;;; Взято здесь http://forum.dwg.ru/showpost.php?p=480876&postcount=120
(defun GetBoundingBox_dynblock
   (ent / lst ins_pt min_point max_point 3d_polarp)
   ;|
(entmakex
  (cons '(0 . "LINE")
(mapcar 'cons '(10 11) (getboundingbox_dynblock nil))
  ) ;_ end of append
) ;_ end of entmakex
|;
      (if
(and (or ent
 (= (type (setq ent (vl-catch-all-apply
      (function
(lambda ()
  (car (entsel "\n???? <??????> : "))
) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of setq
    ) ;_ end of type
    'ename
 ) ;_ end of =
     ) ;_ end of or
     (setq ent (vlax-ename->vla-object ent))
     (vlax-property-available-p ent 'isdynamicblock)
     (equal (vla-get-isdynamicblock ent) :vlax-true)
) ;_ end of and
 (progn
   (vlax-for item
     (vla-item
       (vla-get-blocks
 (vla-get-activedocument (vlax-get-acad-object))
       ) ;_ end of vla-get-blocks
       (vla-get-name ent)
     ) ;_ end of vla-item
     (if (equal (vla-get-visible item) :vlax-true)
       (setq lst (cons item lst))
     ) ;_ end of if
   ) ;_ end of vlax-for
   (setq
     ins_pt (vlax-safearray->list
      (vlax-variant-value
(vla-get-insertionpoint ent)
      ) ;_ end of vlax-variant-value
    ) ;_ end of vlax-safearray->list
     lst
    (vl-remove
      nil
      (mapcar
(function
  (lambda (x / minp maxp)
    (if
      (not (vl-catch-all-error-p
     (vl-catch-all-apply
       (function
 (lambda ()
   (vla-getboundingbox x 'minp 'maxp)
 ) ;_ end of lambda
       ) ;_ end of function
     ) ;_ end of vl-catch-all-apply
   ) ;_ end of vl-catch-all-error-p
      ) ;_ end of not
       (list (cons "min" (vlax-safearray->list minp))
     (cons "max" (vlax-safearray->list maxp))
       ) ;_ end of list
    ) ;_ end of if
  ) ;_ end of lambda
) ;_ end of function
lst
      ) ;_ end of mapcar
    ) ;_ end of vl-remove
     lst    (mapcar
      (function
(lambda (mins)
  (mapcar
    (function
      (lambda (fun)
(apply
  (read mins)
  (mapcar
    (function fun)
    (mapcar
      (function
(lambda (pts)
  (cdr (assoc mins pts))
) ;_ end of lambda
      ) ;_ end of function
      lst
    ) ;_ end of mapcar
  ) ;_ end of mapcar
) ;_ end of apply
      ) ;_ end of lambda
    ) ;_ end of function
    (list car cadr caddr)
  ) ;_ end of mapcar
) ;_ end of lambda
      ) ;_ end of function
      (list "min" "max")
    ) ;_ end of mapcar
     lst    (mapcar
      (function
(lambda (ept)
  (mapcar
    (function
      (lambda (coord_pt coord_line coord_ins)
(+
  (*
    coord_pt
    ((eval
       (read (strcat "vla-get-"
     coord_line
     "EffectiveScaleFactor"
     ) ;_ end of strcat
       ) ;_ end of read
     ) ;_ end of eval
      ent
    )
  ) ;_ end of *
  coord_ins
) ;_ end of +
      ) ;_ end of lambda
    ) ;_ end of function
    ept
    '("X" "Y" "Z")
    ins_pt
  ) ;_ end of mapcar
) ;_ end of lambda
      ) ;_ end of function
      lst
    ) ;_ end of mapcar
   ) ;_ end of setq
 ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of defun