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

Тема в разделе "Autocad", создана пользователем vladislav.blud, 8 фев 2022.

  1. X-Y-H

    X-Y-H Администратор Команда форума

    Барбатос, у меня рекорд 600 листов А1 в 40 А0 70 А2 3 экз одним движением руки - потом только бумагу и картдриджи меняли
    --- Сообщения объединены, 9 фев 2022, Оригинальное время сообщения: 9 фев 2022 ---
    Барбатос, подшивка в pdf и никаких схем?
     
  2. вместо тысячи слов. лисп сам создаст нужное количество листов нужным масштабом по рамкам.
    Код:
    ;;; 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
     
  1. Этот сайт использует файлы cookie. Продолжая пользоваться данным сайтом, Вы соглашаетесь на использование нами Ваших файлов cookie.
    Скрыть объявление
  1. Этот сайт использует файлы cookie. Продолжая пользоваться данным сайтом, Вы соглашаетесь на использование нами Ваших файлов cookie.
    Скрыть объявление