В этот код нужно добавить возможность создания лис...
बनाया गया: 10 फ़रवरी 2026
का उपयोग करके उत्तर दिया गया GPT-5.2 Thinking द्वारा Chat01
बनाया गया: 10 फ़रवरी 2026
का उपयोग करके उत्तर दिया गया GPT-5.2 Thinking द्वारा Chat01
В этот код нужно добавить возможность создания листов для нестандартных форматов
А4х3(297х630мм)
А4х4(297х841мм)
А3х3(420х891мм)
А3х4(420х1189мм)
А2х3(594х1261мм)
А2х4(594х1682мм)
Основной код оставить без изменений
;;; AddLay
;;; Создание листов и видовых экранов
(defun C:ЛИ (/
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:<100>") ; Запрос масштаба
i 0
Points ()
)
(if (not Scale) (setq Scale 100))
(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)))
)
)
)
;;; Создание видовых экранов на листах
(if (= (getvar 'PSLTSCALE) 1) (setvar 'PSLTSCALE 0) )
(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 "monochrome.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
Важный момент: через ActiveX/AutoLISP нельзя “создать” новый размер бумаги в плоттере, можно только выбрать один из размеров, которые уже есть у текущего устройства печати (через CanonicalMediaName). Поэтому нестандартные форматы должны быть заранее добавлены в DWG To PDF.pc3 (или в другой .pc3, который вы используете), а код ниже просто автоматически найдёт нужный размер по фактическим мм и назначит его. (Autodesk Help)
Ниже — добавление без переделки основного кода:
cond выбора формата вставляем 6 новых веток в самое начало (иначе некоторые форматы будут ошибочно попадать в A2/A1/A0 по площади).lisp;;; ----------------------------- ;;; ВСПОМОГАТЕЛЬНЫЕ ФУНКЦИИ ДЛЯ НЕСТАНДАРТНЫХ ФОРМАТОВ ;;; ----------------------------- (defun _al-within (a b tol) (<= (abs (- a b)) tol) ) (defun _al-match-maxmin (w h long short tol / mx mn) (setq mx (max w h) mn (min w h)) (and (_al-within mx long tol) (_al-within mn short tol)) ) ;;; Ищет CanonicalMediaName по реальному размеру бумаги (мм), ;;; предпочитая "ландшафтный" вариант (ширина >= высота), ;;; чтобы ваш существующий PlotRotation работал как раньше. (defun _al-set-canonical-by-mm (lay long short tol / oldMedia mediaNames a1 a2 w h foundAny foundLand units k) (setq oldMedia (vla-get-CanonicalMediaName lay)) ;; обновить список носителей после задания ConfigName снаружи (vla-RefreshPlotDeviceInfo lay) ;; учёт единиц бумаги (0=inches, 1=mm) (setq units (vla-get-PaperUnits lay)) (if (= units 0) (progn (setq long (/ long 25.4) short (/ short 25.4) tol (/ tol 25.4)) ) ) (setq mediaNames (vlax-invoke lay 'GetCanonicalMediaNames) foundAny nil foundLand nil) (foreach k mediaNames (vla-put-CanonicalMediaName lay k) (vla-GetPaperSize lay 'a1 'a2) (setq w (vlax-variant-value a1) h (vlax-variant-value a2)) (if (_al-match-maxmin w h long short tol) (progn (setq foundAny k) (if (>= w h) (setq foundLand k)) ) ) ) (cond (foundLand (vla-put-CanonicalMediaName lay foundLand) T) (foundAny (vla-put-CanonicalMediaName lay foundAny) T) (T (vla-put-CanonicalMediaName lay oldMedia) nil) ) )
Найдите у себя место:
lisp(cond ; Выбор формата в зависимости от площади видового экрана ((and (> Square 59251) (< Square 65488)) ... ... )
И сразу после строки:
lisp(cond ; Выбор формата в зависимости от площади видового экрана
вставьте эти 6 веток (остальное ниже оставьте как было):
lisp;; --- Нестандартные форматы (по размерам, а не по площади) --- ;; ВАЖНО: размеры задаём "long x short" (длинная сторона, короткая), ;; чтобы ваш PlotRotation работал как со стандартными ISO_full_bleed_* ((_al-match-maxmin ViewportWidth ViewportHight 630 297 5.0) ; A4x3 (297x630) (vla-put-ConfigName Layout "DWG To PDF.pc3") (if (not (_al-set-canonical-by-mm Layout 630 297 5.0)) (vla-put-ConfigName Layout "Нет") ) ) ((_al-match-maxmin ViewportWidth ViewportHight 841 297 5.0) ; A4x4 (297x841) (vla-put-ConfigName Layout "DWG To PDF.pc3") (if (not (_al-set-canonical-by-mm Layout 841 297 5.0)) (vla-put-ConfigName Layout "Нет") ) ) ((_al-match-maxmin ViewportWidth ViewportHight 891 420 5.0) ; A3x3 (420x891) (vla-put-ConfigName Layout "DWG To PDF.pc3") (if (not (_al-set-canonical-by-mm Layout 891 420 5.0)) (vla-put-ConfigName Layout "Нет") ) ) ((_al-match-maxmin ViewportWidth ViewportHight 1189 420 5.0) ; A3x4 (420x1189) (vla-put-ConfigName Layout "DWG To PDF.pc3") (if (not (_al-set-canonical-by-mm Layout 1189 420 5.0)) (vla-put-ConfigName Layout "Нет") ) ) ((_al-match-maxmin ViewportWidth ViewportHight 1261 594 5.0) ; A2x3 (594x1261) (vla-put-ConfigName Layout "DWG To PDF.pc3") (if (not (_al-set-canonical-by-mm Layout 1261 594 5.0)) (vla-put-ConfigName Layout "Нет") ) ) ((_al-match-maxmin ViewportWidth ViewportHight 1682 594 5.0) ; A2x4 (594x1682) (vla-put-ConfigName Layout "DWG To PDF.pc3") (if (not (_al-set-canonical-by-mm Layout 1682 594 5.0)) (vla-put-ConfigName Layout "Нет") ) ) ;; --- дальше ваш существующий код БЕЗ ИЗМЕНЕНИЙ --- ((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 "Нет") )
DWG To PDF.pc3, функция найдёт его по реальным мм и назначит CanonicalMediaName.ConfigName = "Нет".Если хотите — могу добавить маленькую диагностическую печать в командную строку (какой CanonicalMediaName был найден для каждого листа), но это уже будет ещё одна правка.