Печать из модели по выбору объекта

zenon · 21.10.2009, 12:41

Просьба не отсылать в поиск, ибо прошерстил, но не то.
Что хотелось бы, выбираешь объект, а программа сама определяет габариты границы объекта и отправляет на печать все что попадает в габариты.
Настройку предлагаю производить либо при первичной загрузке программы, либо предварительно настроить стиль печати.

ps см. в приложении что и как.

исходник.dwg

KennyMckormik · 21.10.2009, 13:02

Какой объект хочешь выбирать?

zenon · 21.10.2009, 13:04

KennyMckormik, приложение смотрел??

Кулик Алексей aka kpblc · 21.10.2009, 13:12

Так это тебе фактически надо через vla-getBoundingBox получить границы объектов. Правда, есть одно "но": блоки с атрибутами обрабатываются не всегда корректно. На форуме, насколько я помню, была подобная тема (автор работающего лиспа, кажется, VVA; но могу и ошибаться).

zenon · 21.10.2009, 13:52

Кулик Алексей aka kpblc, насколько понял из того, что нашел там основная мысль в предварительной прорисовке рамки либо спецблока. Не то что хотелось-бы.
ps на первых порах атрибуты можно и не учитывать.

Nike · 21.10.2009, 13:56

например так:

Код:

[Выделить все]

(defun GetBoundingBox (en / obj minpt maxpt)
  (if (= (type en) 'ENAME)
    (progn
      (setq obj (vlax-ename->vla-object en))
      (vla-getboundingbox obj 'minpt 'maxpt)
      (list
        (trans (vlax-safearray->list minpt) 0 1)
        (trans (vlax-safearray->list maxpt) 0 1)
      ) ;_ end of list
    ) ;_ end of progn
  ) ;_endof if progn 
) ;_endof defun

(setq box (GetBoundingBox (car(entsel)))); список из координат минимума и максимума габаритов выбранного объекта
(setq xy1 (car box)); координаты для определения области печати, xy1 - левая нижняя, xy2 - правая верхняя 
(setq xy2 (car (cdr box)))

zenon · 21.10.2009, 14:10

Nike, так понимаю сие определяет координаты для печати, вопрос а что с ними дальше делать??
Offtop: ps ссори за мой французский, но в программировании не силен.

Nike · 21.10.2009, 14:15

ну а дальше эти координаты в (command "_.plot" подставлять
например как уменя:

Код:

[Выделить все]

       (command "_.plot" ;сама команда 
             "_Yes" ;нужны настройки 
             "model" ; Имя листа или [?] <Модель>: 
             printer ;Имя устройства вывода или [?] <HP2200-PCL6.pc3>: 
             format ;Формат листа бумаги или [?] <A4>: 
             "Millimeters" ;Единицы измерения размеров листа [Дюймы/Миллиметры] <дюйм>:
             a ;Ориентация чертежа [Книжная/Альбомная] <Книжная>: 
             "_No" ;Перевернуть чертеж? [Да/Нет] <Нет>:
             "_Window" ;Печатаемая область [Экран/Границы/Лимиты/Вид/Рамка] <Рамка>:
             xy1 ;Первая точка окна 
             xy2 ;Вторая точка окна 
             fit ;[Вписать] <Вписать>: ("_fit")
             "_center" ;Смещение от начала (x,y) или [Центрировать] <Центрировать>: 
             "_yes" ;Учитывать стили печати? [Да/Нет] <Да>:
             plotstyle ;Имя таблицы стилей печати или [?] (. если нет) <monochrome.ctb>:
             line-weight ;Учитывать веса линий? [Да/Нет] <Да>:
             "As displayed" ;Режим вывода раскрашенных ВЭ [Обычный/Каркас/Скрытие линий/Тонирование] <Обычный>:
             "_No" ;Запись чертежа в файл [Да/Нет] <Н>:
             "_yes" ;Сохранить изменения параметров листа [Да/Нет]? 
             Plot-not-prew ;Перейти к печати [Да/Нет] <Д>: 
    ) ;_ end of command

ну, у меня там свои переменные еще - printer, format, plotstyle, line-weight - определются настройками перед печатью пользователем и по выбору объекта. Если выбран блок с именеи "А4" то printer = HP2200-PCL6.pc3, если "А1" то HP DesignJet 500.pc3, например..

zenon · 21.10.2009, 14:19

Nike, прошу прошения, но как сие использовать?? загнать как макрос на кнопку??

Nike · 21.10.2009, 14:25

Offtop: zenon, ты не знаешь, как LISP-программы использовать?

zenon · 21.10.2009, 14:43

Offtop: Nike, знаю, но твой код больше смахивает на макрос на кнопку,
здесь http://dwg.ru/art/8 как-то по другому описано.
Если не трудно распиши как и что.

Nike · 21.10.2009, 14:52

Offtop: zenon, это не макрос на кнопку, а фрагменты программы печати, которые интересуют, как я думаю, автора темы - код определения области печати по габаритам выбираемого объекта и собственно функция печати этой области. Помимо этого там еще куча вспомогательных замороченных функций, определяющих параметры печати. Это к теме не относится..

zenon · 21.10.2009, 14:58

Nike, автора темы

интересует программа готовая к применению

Nike · 21.10.2009, 15:20

ну вот например, для печати выбранного объекта на принтер HP CLJ 5550N PCL 6 A4.pc3 (надо подставить свой) на листе А4:

Код:

[Выделить все]

(defun GetBoundingBox (en / obj minpt maxpt)
  (if (= (type en) 'ENAME)
    (progn
      (setq obj (vlax-ename->vla-object en))
      (vla-getboundingbox obj 'minpt 'maxpt)
      (list
        (trans (vlax-safearray->list minpt) 0 1)
        (trans (vlax-safearray->list maxpt) 0 1)
      ) ;_ end of list
    ) ;_ end of progn
  ) ;_endof if progn 
) ;_endof defun

(princ "Выберите объект для печати")
(setq box (GetBoundingBox (car(entsel)))); список из координат минимума и максимума габаритов выбранного объекта
(setq xy1 (car box)); координаты для определения области печати, xy1 - левая нижняя, xy2 - правая верхняя 
(setq xy2 (car (cdr box)))

(command "_.plot"
             "_Yes"
             "model" ; Имя листа или [?] <Модель>: 
             "HP CLJ 5550N PCL 6 A4.pc3" ;Имя устройства вывода 
             "A4" ;Формат листа бумаги
             "Millimeters" ;Единицы измерения размеров листа
             "portrait" ;Ориентация чертежа 
             "_No" ;Перевернуть чертеж?
             "_Window" ;Печатаемая область
             xy1 ;Первая точка окна 
             xy2 ;Вторая точка окна 
             "_fit" ;[Вписать]
             "_center" ;Смещение от начала (x,y) или [Центрировать]
             "_yes" ;Учитывать стили печати?
             "monochrome.ctb" ;Имя таблицы стилей печати
             "_yes" ;Учитывать веса линий?
             "As displayed" ;Режим вывода раскрашенных ВЭ
             "_No" ;Запись чертежа в файл
             "_yes" ;Сохранить изменения параметров листа
             "_yes" ;Перейти к печати
    ) ;_ end of command

Цитата:

автора темы интересует

прошу пардону за невнимательнось blush:

zenon · 21.10.2009, 15:37

Nike, программа загрузилась, при загрузке появился запрос на выбор объекта, отправило на печать все хорошо, как повторно запустить прогу?? опять через загрузку??
вот что выдает на ввод

Цитата:

Command: GetBoundingBox
Unknown command "GETBOUNDINGBOX". Press F1 for help.

Цитата:

Command: (GetBoundingBox)
; error: too few arguments

что не так??

ps хотелось-бы создать кнопку с макросом типа

Цитата:

^C^C(if (null C:<команда>)(load "<файл>"));<команда>;

Nike · 21.10.2009, 16:16

ну так засунь этот код в функцию, например
(defun c:zenon ()
<вышеприведенный код>
)
Сохрани в zenon.lsp и создавай свою кнопку:
^C^C(if (null C:zenon)(load "zenon"));zenon;

Это же все описано в http://dwg.ru/art/8, почитае еще внимательнее

zenon · 21.10.2009, 16:33

Цитата:

Сообщение от Nike

ну так засунь этот код в функцию, например
(defun c:zenon ()
<вышеприведенный код>
)

спасибо

получилось

можно еще потретирую??
1 - выбрать 2 тип (сплайн), то почему-то габариты больше чем у требуемого прямоугольника, если это не лечится то и фиг с ним.
2 - что очень желательно, можно ли как-то заставить программу автоматически выставлять требуемую конфигурацию листа, скажем если габарит ширины требуемой области печати > габарита высоты, то ориентация листа горизонтально, иначе вертикально.

PSS Да вот еще с динамическими блоками ведет себя странно, так при наличии параметра видимость в блоке, выбор происходит по габариту наибольшего из объектов блока, даже если он в данном вхождении и не отображается.

Nike · 21.10.2009, 16:54

А саму сообразить

это ж элементарно
Например так:

Код:

[Выделить все]

 (setq a (angle xy1 xy2));угол для вычисления ориентации листа
;;; Ориентация листа: если угол в диапазоне 45...135 или 225...315 то портрет, иначе - альбом
             (if (or (and (> a (* pi 0.25)) (< a (* pi 0.75))) (and (> a (* pi 1.25)) (< a (* pi 1.75))))
               (setq orientation "Portrait") 
               (setq orientation "Landscape") 
             ) ;_ end of if

этот код вставить перед командой _plot, а строку

Код:

[Выделить все]

"portrait" ;Ориентация чертежа

заменить на

Код:

[Выделить все]

orientation ;Ориентация чертежа

С первым вопросом - х.з..
С динамическими блоками тоже такую фигню видел. Как лечить - хз. Крыса & co надо в помощь..

zenon · 21.10.2009, 17:38

Nike, большой тебе спасиб

Offtop: а насчет Крыса, придется наверно позвать
ДЕ-ДУ-ШКА МО-РОЗ эээ тоисть Кулик Алексей aka kpblc

Nike · 21.10.2009, 17:55

Цитата:

Сообщение от zenon

Nike, большой тебе спасиб

Большой пожалуйста!

gliv · 21.10.2009, 19:29

скажите уважаемые, а существует ли возможность создать лисп, который находил бы блоки, брал с них формат листа и соответственно выводил каждый из низ на печать.

Дима_ · 21.10.2009, 20:14

Цитата:

Сообщение от Nike

...
С первым вопросом - х.з..
С динамическими блоками тоже такую фигню видел. Как лечить - хз. Крыса & co надо в помощь..

Тут скорее винной командные методы - да да привязочки, я думаю замена

Код:

[Выделить все]

 xy1 ;Первая точка окна 
 xy2 ;Вторая точка окна

на

Код:

[Выделить все]

 "_none" xy1 ;Первая точка окна 
 "_none" xy2 ;Вторая точка окна

поможет.

Do$ · 21.10.2009, 22:04

Насчет сплайна - действительно getBoundingBox выдает точки довольно далеко от краев линии. Для печати, наверное, это не особо критично

Кулик Алексей aka kpblc · 21.10.2009, 23:46

Я попытался "нарисовать" код, который для сплайна будет выдавать данные по другому алгоритму, но не преуспел. Кто может - добейте:

Код:

[Выделить все]

(defun getboundingbox-spline (ent             /
                              _kpblc-conv-list-to-3dpoints
                              res             controlpoints
                              fitpoints       minp
                              maxp            minfit
                              mincontrol      maxfit
                              maxcontrol
                              )
                             ;|
*	Вычисление BoundingBox'a для SPLINE
*	ent указатель на spline (ename || vla)
|;
  (defun _kpblc-conv-list-to-3dpoints (lst / res)
                                      ;|
*    Функция конвертации списка чисел в список 3-мерных точек. На основе уроков
* по рекурсиям Евгения Елпанова
*    Параметры вызова:
*	lst	список чисел
*    Примеры вызова:
(_kpblc-conv-list-to-3dpoints '(1 2 3 4 5 6)) ;-> ((1 2 3) (4 5 6))
(_kpblc-conv-list-to-3dpoints '(1 2 3 4 5))   ;-> ((1 2 3) (4 5 0.))
|;
    (cond
      ((not lst)
       nil
       )
      (t
       (setq res (cons (list (car lst)
                             (if (cadr lst)
                               (cadr lst)
                               0.
                               ) ;_ end of if
                             (if (caddr lst)
                               (caddr lst)
                               0.
                               ) ;_ end of if
                             ) ;_ end of list
                       (_kpblc-conv-list-to-3dpoints (cdddr lst))
                       ) ;_ end of cons
             ) ;_ end of setq
       )
      ) ;_ end of cond
    res
    ) ;_ end of defun

  (cond
    ((= (type ent) 'ename)
     (setq res (getboundingbox-spline (vlax-ename->vla-object ent)))
     )
    ((and (= (type ent) 'vla-object)
          (= (vla-get-objectname ent) "AcDbSpline")
          ) ;_ end of and
     (vla-getboundingbox ent 'minp 'maxp)
     (setq controlpoints (_kpblc-conv-list-to-3dpoints
                           (vlax-safearray->list
                             (vlax-variant-value
                               (vla-get-controlpoints ent)
                               ) ;_ end of vlax-variant-value
                             ) ;_ end of vlax-safearray->list
                           ) ;_ end of _kpblc-conv-list-to-3dpoints
           fitpoints     (_kpblc-conv-list-to-3dpoints
                           (vlax-safearray->list
                             (vlax-variant-value (vla-get-fitpoints ent))
                             ) ;_ end of vlax-safearray->list
                           ) ;_ end of _kpblc-conv-list-to-3dpoints
           minp          (vlax-safearray->list minp)
           maxp          (vlax-safearray->list maxp)
           minfit        (mapcar '(lambda (f)
                                    (apply 'min (mapcar f fitpoints))
                                    ) ;_ end of lambda
                                 (list 'car 'cadr 'caddr)
                                 ) ;_ end of mapcar
           maxfit        (mapcar '(lambda (f)
                                    (apply 'max (mapcar f fitpoints))
                                    ) ;_ end of lambda
                                 (list 'car 'cadr 'caddr)
                                 ) ;_ end of mapcar
           mincontrol    (mapcar '(lambda (f)
                                    (apply 'min (mapcar f controlpoints))
                                    ) ;_ end of lambda
                                 (list 'car 'cadr 'caddr)
                                 ) ;_ end of mapcar
           maxcontrol    (mapcar '(lambda (f)
                                    (apply 'max (mapcar f controlpoints))
                                    ) ;_ end of lambda
                                 (list 'car 'cadr 'caddr)
                                 ) ;_ end of mapcar
           res           (list
                           (cons
                             "min"
                             (mapcar '(lambda (f)
                                        (apply 'max
                                               (mapcar f (list minfit mincontrol minp))
                                               ) ;_ end of apply
                                        ) ;_ end of lambda
                                     (list 'car 'cadr 'caddr)
                                     ) ;_ end of mapcar
                             ) ;_ end of cons
                           (cons
                             "max"
                             (mapcar '(lambda (f)
                                        (apply 'min
                                               (mapcar f (list maxfit maxcontrol maxp))
                                               ) ;_ end of apply
                                        ) ;_ end of lambda
                                     (list 'car 'cadr 'caddr)
                                     ) ;_ end of mapcar
                             ) ;_ end of cons
                           ) ;_ end of list
           ) ;_ end of setq
     )
    (t
     (vla-getboundingbox ent 'minp 'maxp)
     (setq minp (vlax-safearray->list minp)
           maxp (vlax-safearray->list maxp)
           res  (list (cons "min" minp) (cons "max" maxp))
           ) ;_ end of setq
     )
    ) ;_ end of cond
  res
  ) ;_ end of defun

Результат неверен, говорю сразу.
Насчет дин.блоков... Там по идее надо точно так же, как и для обычных блоков (скажу честно, подобными задачами не занимался, подробный код сейчас сотворить не в силах

)

Disney · 22.10.2009, 07:45

Вот насочинял чуть-чуть, чтоб со сплайном по-корректнее было

Код:

[Выделить все]

 
(defun c:test (/ object obj t1t2 t1 t2)
  (vl-load-com)
  (setq object (car (entsel))
 obj    (vlax-ename->vla-object object)
  )
  (if (= (vla-get-objectname obj) "AcDbSpline")
    (setq t1t2 (getboundingbox_spl object obj)
   t1   (car t1t2)
   t2   (cadr t1t2)
    )
    (progn (vla-GetBoundingBox
      obj
      'minPt
      'maxPt
    )
    (setq t1 (vlax-safearray->list minPt)
   t2 (vlax-safearray->list maxPt)
    )
    )
  )
)
 
(defun getboundingbox_spl (spl     obj      /       pogreshnost
      oldcolor nabor    i       spis     koord
      minX     minY     maxX     maxY
     )
  (setq
    pogreshnost (/ (vlax-curve-getendparam obj) 2000)
    oldcolor (getvar "CECOLOR")
  )
  (setvar "CECOLOR" "222")
  (vl-cmdf "_divide" spl 1000)
  (setq
    nabor (ssget "_X" '((0 . "POINT") (62 . 222)))
    i   0
    spis  '()
  )
  (repeat (sslength nabor)
    (setq
      koord (cdr (assoc 10 (entget (ssname nabor i))))
      spis  (cons koord spis)
      i     (1+ i)
    )
  )
  (setq
    minX (caar spis)
    minY (cadar spis)
    maxX minX
    maxY minY
    spis (cons (vlax-curve-getStartPoint obj)
        (cons (vlax-curve-getEndPoint obj) spis)
  )
  )
  (vl-cmdf "_.erase" nabor "")
  (mapcar (function (lambda (x)
        (setq minX (min minX (car x))
       maxX (max maxX (car x))
       minY (min minY (cadr x))
       maxY (max maxY (cadr x))
        )
      )
   )
   spis
  )
  (setvar "CECOLOR" oldcolor)
  (list (list (- minX pogreshnost) (- minY pogreshnost))
 (list (+ maxX pogreshnost) (+ maxY pogreshnost))
  )
)

Если сначало нарисовать полилинию, а потом её "сплайнить", то у неё появяться выносные ручки не лежащие на самой полилинии, может vla-GetBoundingBox каким-то образом у сплайна эти ручки находит, и по ним расширяет габариты?

Do$ · 22.10.2009, 08:35

Цитата:

Сообщение от Disney

Если сначало нарисовать полилинию, а потом её "сплайнить", то у неё появяться выносные ручки не лежащие на самой полилинии, может vla-GetBoundingBox каким-то образом у сплайна эти ручки находит, и по ним расширяет габариты?

Не похоже - См. вложение. Сплайн нарисован вручную, ручки на сплайне, красный прямоугольник построен по точкам, полученным функцией GetBoundingBox:

Код:

[Выделить все]

(defun c:test ( / getBoundingBox box)
  (defun getBoundingBox	(ent / minpt maxpt)
    (vl-load-com)
    (vla-GetBoundingBox
      (vlax-ename->vla-object ent)
      'minpt
      'maxpt
    ) ;_ end of vla-GetBoundingBox
    (list
      (vlax-safearray->list minpt)
      (vlax-safearray->list maxpt)
    ) ;_ end of list
  ) ;_ end of defun

  (setq box (getBoundingBox (car (entsel "\nSelect spline:"))))
  (vl-cmdf "_.rectang" (car box) (last box) "")
  (princ)
) ;_ end of defun

Disney · 22.10.2009, 08:59

Цитата:

Сообщение от Do$

Не похоже

Похоже

зелёным - vla-GetBoundingBox для сплайна
красным - сплайн
синим - полилиния, сглаженная сплайном
с лева ручки включены у полилинии, с право у сплайна.
Ну, если честно, я в ручную подгонял, так чтоб и полилиния совпадала со сплайном, и чтоб ручки совпадали с габаритом.

zenon · 22.10.2009, 09:29

Ладно фиг с ним с сплайном, по поводу динамических блоков что-то намечается?

Do$ · 22.10.2009, 09:54

Цитата:

Сообщение от zenon

Ладно фиг с ним с сплайном

Погодите, святой отец

Во вложении файл. Сплайны нарисованы вручную, прямоугольная рамка вокруг них - это результат GetBoundingBox при помощи кода из #26. Полилинии построены по контрольным точкам спланов, при помощи кода:

Код:

[Выделить все]

(defun c:test1 ( / _kpblc-conv-list-to-3dpoints)

  (defun _kpblc-conv-list-to-3dpoints (lst / res)
				      ;|
*    Функция конвертации списка чисел в список 3-мерных точек. На основе уроков
* по рекурсиям Евгения Елпанова
*    Параметры вызова:
*	lst	список чисел
*    Примеры вызова:
(_kpblc-conv-list-to-3dpoints '(1 2 3 4 5 6)) ;-> ((1 2 3) (4 5 6))
(_kpblc-conv-list-to-3dpoints '(1 2 3 4 5))   ;-> ((1 2 3) (4 5 0.))
|;
    (cond
      ((not lst)
       nil
      )
      (t
       (setq res (cons (list (car lst)
			     (if (cadr lst)
			       (cadr lst)
			       0.
			     ) ;_ end of if
			     (if (caddr lst)
			       (caddr lst)
			       0.
			     ) ;_ end of if
		       ) ;_ end of list
		       (_kpblc-conv-list-to-3dpoints (cdddr lst))
		 ) ;_ end of cons
       ) ;_ end of setq
      )
    ) ;_ end of cond
    res
  ) ;_ end of defun

  (vl-cmdf "_.pline")
  (foreach
	    x
	    (_kpblc-conv-list-to-3dpoints
	      (vlax-safearray->list
		(vlax-variant-value
		  (vla-get-controlpoints
		    (vlax-ename->vla-object (car (entsel "\nSpline?:")))
		  ) ;_ end of vla-get-controlpoints
		) ;_ end of vlax-variant-value
	      ) ;_ end of vlax-safearray->list
	    ) ;_ end of _kpblc-conv-list-to-3dpoints
    (vl-cmdf x)
  ) ;_ end of foreach
  (vl-cmdf "")
) ;_ end of defun

Как я понял, граница сплайна берется по контрольной точке (что за зверь такой?

), если угол между прямыми, проведенными в ближайшие контрольные точки тупой. А вот если острый - там какой-то другой алгоритм...

Цитата:

Сообщение от zenon

по поводу динамических блоков что-то намечается?

По поводу динамических блоков с параметром видимости - вполне логично, что границы блока будут браться по наибольшему примитиву, даже если он не виден. Я так думаю, что самый простой вариант - взрывать блок, создавать из "осколков" новый и прогонять через программу.

Кулик Алексей aka kpblc · 22.10.2009, 10:35

Зачем? На уровне идеи: не проще ли будет получать описание блока через (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vla-get-name block_reference) и исключать из обработки примитивы, у которых visible = false?

Disney · 22.10.2009, 10:57

Да уж хитрый сплайн, попробовал его так

Код:

[Выделить все]

 
(defun C:test ()
  (vl-load-com)
  (setq obj  (entsel "Сплайн")
 prim (entget (car obj))
 obj  (vlax-ename->vla-object (car obj))
 sp   '()
 sp   (mapcar
        'cdr
        (vl-remove-if-not
   '(lambda (x) (= (car x) 10))
   prim
        )
      )
  )
  (ru-pline-entmake sp nil nil 0 50)
  (setq pol (entlast))
  (vl-cmdf "_pedit" pol "_s" "")
  (vla-GetBoundingBox
    (vlax-ename->vla-object (entlast))
    'minPt
    'maxPt
  )
  (vl-cmdf "_.erase" pol "")
  (setq t1 (vlax-safearray->list minPt)
 t2 (vlax-safearray->list maxPt)
  )
)
 
 
(defun ru-pline-entmake
       (points is_closed is_3d width lineweight / elst ENTL)
;;; (ru-pline-entmake (список_вершин) флаг_замкнутости
;;; флаг_делать_3М_ПЛИНИЮ)
;;; возвращает имя примитива - полилинии или NIL, если что-то не
;;; вышло.
  ;|
Пример:
(ru-pline-entmake
(list
(list 220.65 345.001)
(list 332.622 546.525)
(list 846.376 320.906)
(list 719.035 121.572)
) T nil 0 50)
|;
  (if is_3d
    (progn
      (setq entl
      (list
        '(0 . "POLYLINE")
        '(100 . "AcDbEntity")
        '(100 . "AcDb3dPolyline")
        '(66 . 1)
        '(10 0.0 0.0 0.0)
        (cons 70
       (logior 8
        (if is_closed
          1
          0
        ) ;_ end of if
        (if (= 1 (getvar "PLINEGEN"))
          128
          0
        ) ;_ end of if
       ) ;_ end of logior
        ) ;_ end of cons
      ) ;_ end of list
      ) ;_ end of setq
      (if (entmake entl)
 (progn
   (foreach v points
     (progn
       (setq entl
       (list
         '(0 . "VERTEX")
         '(100 . "AcDbEntity")
         '(100 . "AcDbVertex")
         '(100 . "AcDb3dPolylineVertex")
         (append '(10) v)
         '(70 . 32)
       ) ;_ end of list
       ) ;_ end of setq
       (entmake entl)
     ) ;_ end of progn
   ) ;_ end of foreach
   (if (entmake '((0 . "SEQEND") (100 . "AcDbEntity")))
     (entupd (entlast))
     nil
   ) ;_ end of if
 ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of progn
    (progn
      (setq elst (append
     (list
       '(0 . "LWPOLYLINE")
       '(100 . "AcDbEntity")
       '(100 . "AcDbPolyline")
     ;(cons 8 (getvar "CLAYER"))
       (cons 90 (length points))
       (cons 43 width)
       (cons 370 lineweight)
       (cons 70
      (logior (if is_closed
         1
         0
       ) ;_ end of if
       (if (= 1 (getvar "PLINEGEN"))
         128
         0
       ) ;_ end of if
      ) ;_ end of logand
       )   ; _ end of cons;;;
     ) ;_ end of list
     (mapcar '(lambda (p)
         (list 10 (car p) (cadr p))
       ) ;_ end of lambda
      points
     ) ;_ end of mapcar
   ) ;_ end of append
      ) ;_ end of setq
      (if (entmake elst)
 (entupd (entlast))
 nil
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

Похоже, но не точно, габарит может быть, как чуть больше(что не страшно), так и чуть меньше(что не приятно

).

Цитата:

Как я понял, граница сплайна берется по контрольной точке (что за зверь такой?

), если угол между прямыми, проведенными в ближайшие контрольные точки тупой. А вот если острый - там какой-то другой алгоритм...

Ну, тут ты не совсем честен, ты зачем верхнюю вершину, полилинии построенной по контрольным точкам, к рамке подтянул?

Do$ · 22.10.2009, 11:09

Цитата:

Сообщение от Disney

Ну, тут ты не совсем честен, ты зачем верхнюю вершину, полилинии построенной по контрольным точкам, к рамке подтянул?

Гадом буду! Только цвет поменял и тип линии - остальное все само построилось

Коды выложил, чертеж есть - проверь!

Кулик Алексей aka kpblc · 22.10.2009, 11:12

Объектную привязку забыл снести

Do$ · 22.10.2009, 11:22

Цитата:

Сообщение от Кулик Алексей aka kpblc

Объектную привязку забыл снести

Виноват

Значит все не так просто, как я думал.

Дима_ · 22.10.2009, 11:58

Да действительно со спалйном не лады у getbounbox'а - но intersectionwith работает правильно - если кому принципиально можно "намолевать" рекурсивный аналог getbounboxa с заданной точностью ну скажем до 0.000001 при помощи "золотого сечения" (для незнающих наберите в гуле "метод золотого сечения"). Самому совсем не как сейчас.

zenon · 22.10.2009, 12:03

так что насчет динблоков с параметром видимость

Кулик Алексей aka kpblc · 22.10.2009, 12:07

Дай пример

Вечером, если не забуду (и если до этого уже не будет решения) - попробую сделать.

zenon · 22.10.2009, 12:27

Цитата:

Сообщение от Кулик Алексей aka kpblc

Дай пример Вечером, если не забуду (и если до этого уже не будет решения) - попробую сделать.

держи
Temp.dwg

LSN · 22.10.2009, 13:38

Или вот еще образец

Кулик Алексей aka kpblc · 22.10.2009, 14:11

Сделать корректно работающий код не получилось даже для тепличных условий. Явно где-то в логике ошибка

Для тех, кто захочет "добить до ума":

Код:

[Выделить все]

(defun test (/ ent lst min_point max_point)
  (if (and (= (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 =
           (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))) (vla-get-name ent))
        (if (equal (vla-get-visible item) :vlax-true)
          (setq lst (cons item lst))
          ) ;_ end of if
        ) ;_ end of vlax-for
      (setq 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
            min_point (mapcar (function +)
                              (mapcar (function
                                        (lambda (f)
                                          (apply
                                            (function min)
                                            (mapcar f
                                                    (mapcar
                                                      (function
                                                        (lambda (x) (cdr (assoc "min" x)))
                                                        ) ;_ 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
                              (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint ent)))
                              ) ;_ end of mapcar
            max_point (mapcar (function +)
                              (mapcar (function
                                        (lambda (f)
                                          (apply
                                            (function max)
                                            (mapcar f
                                                    (mapcar
                                                      (function
                                                        (lambda (x) (cdr (assoc "min" x)))
                                                        ) ;_ 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
                              (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint ent)))
                              ) ;_ end of mapcar
            lst       (list (cons "min" min_point) (cons "max" max_point))
            ) ;_ end of setq
      ) ;_ end of progn
    ) ;_ end of if
  lst
  ) ;_ end of defun

Из обработки напрочь исключаются атрибуты; не учитывается поворот и немировая система координат; не рассматривается вопрос масштаба, не равного 1.0 хотя бы по одному из направлений.

Do$ · 22.10.2009, 22:03

Нижнюю левую точку находит верно, с правой верхней неполадки... Покопаюсь.

Кулик Алексей aka kpblc · 22.10.2009, 22:04

Ну, у меня фантазий сдох окончательно и бесповоротно

Do$ · 22.10.2009, 22:07

Код:

[Выделить все]

(defun test (/ ent lst min_point max_point)
  (if (and (= (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 =
           (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))) (vla-get-name ent))
        (if (equal (vla-get-visible item) :vlax-true)
          (setq lst (cons item lst))
          ) ;_ end of if
        ) ;_ end of vlax-for
      (setq 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
            min_point (mapcar (function +)
                              (mapcar (function
                                        (lambda (f)
                                          (apply
                                            (function min)
                                            (mapcar f
                                                    (mapcar
                                                      (function
                                                        (lambda (x) (cdr (assoc "min" x)))
                                                        ) ;_ 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
                              (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint ent)))
                              ) ;_ end of mapcar
            max_point (mapcar (function +)
                              (mapcar (function
                                        (lambda (f)
                                          (apply
                                            (function max)
                                            (mapcar f
                                                    (mapcar
                                                      (function
                                                        (lambda (x) (cdr (assoc "max" x)))
                                                        ) ;_ 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
                              (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint ent)))
                              ) ;_ end of mapcar
            lst       (list (cons "min" min_point) (cons "max" max_point))
            ) ;_ end of setq
      ) ;_ end of progn
    ) ;_ end of if
  lst
  ) ;_ end of defun

min вместо max было

ПС: Работает изумительно!

Кулик Алексей aka kpblc · 22.10.2009, 22:13

Offtop: Е-мое... Ну надо же было так лажануться! Что значит копи-паст кода.

zenon · 23.10.2009, 09:46

Просьба к зубрам а теперь можно оформить сие в рабочую программу, с учетом поста 1

Сергей Богатов · 23.10.2009, 12:57

Offtop:
может понаделать листов и печатать из них?

zenon · 23.10.2009, 13:27

Цитата:

Сообщение от Сергей Богатов

может понаделать листов и печатать из них?

Это не всегда оправдано, тут еще больше телодвижений чем при печати из модели

CB · 24.10.2009, 09:19

Здесь и здесь рассматривался метод бисекции. Так вот, этот метод вполне иожно применить для нахождения габаритного контейнера для сплайна (и не только) . Вот один из вариантов рекурсивного аналога getbounbox'a:

Код:

[Выделить все]

(defun rec-boundingBox (/ f test test1 lst obj)
  (setq f
      (lambda (x y)
        (apply
          'or
          (mapcar
            'minusp
            (mapcar '*
                    (vlax-curve-getFirstDeriv obj x)
                    (vlax-curve-getFirstDeriv obj y)
            ) ;_  mapcar
          ) ;_  mapcar
        ) ;_  apply
      ) ;_  lambda
  ) ;_  setq
  (defun test (a b d)
    (if (= a b)
      nil
      ((lambda (r)
         (if (equal a r d)
           r
           (if (f a r)
             (test a r d)
             (test r b d)
           ) ;_  if
         ) ;_  if
       ) ;_  lambda
        (/ (+ a b) 2.)
      )
    ) ;_  if
  ) ;_  defun
  (defun test1 (a b e)
    (cond
      ((> b e) (list e))
      ((f a b)
       (cons (test a b 1.0e-010) (test1 b (1+ b) e))
      )
      (t (test1 b (1+ b) e))
    ) ;_  cond
  ) ;_  defun
  (if
    (and (setq obj
                (car (entsel
                       "\nВыберите pline,spline,ellipse: "
                     ) ;_  entsel
                ) ;_  car
         ) ;_  setq
         (wcmatch (cdr (assoc 0 (entget obj)))
                  "SPLINE,ELLIPSE,*LINE,CIRCLE,ARC"
         ) ;_  wcmatch
         (setq obj (vlax-ename->vla-object obj))
    ) ;_ end of and
     ((lambda (lst)
        (list (list (apply 'min (mapcar 'car lst))
                    (apply 'min (mapcar 'cadr lst))
              ) ;_  list
              (list (apply 'max (mapcar 'car lst))
                    (apply 'max (mapcar 'cadr lst))
              ) ;_  list
        ) ;_  list
      ) ;_  lambda
       (mapcar
         '(lambda (x)
            (vlax-curve-getPointAtParam obj x)
          ) ;_  lambda
         (cons 0.0
               (test1 0 1 (vlax-curve-getEndParam obj))
         ) ;_  cons
       ) ;_  mapcar
     )
  ) ;_  if
) ;_  defun
 
;;;Проверка
(progn
  (vl-cmdf "_rectang")
  (apply 'vl-cmdf (rec-boundingBox))
) ;_ end of progn

Do$ · 24.10.2009, 14:47

Код:

[Выделить все]

Команда: 'VLIDE _rectang
Первый угол или [Фаска/Уровень/Сопряжение/Высота/Ширина]:
Выберите pline,spline,ellipse: Возникла серьезная ошибка ***
достигнут внутренний предел стека (смоделирован)"\n*** INTERNAL ERROR: VL 
namespace mismatch\n"" type Y to reset: "y

Не справилась

CB · 25.10.2009, 11:03

Согласен, при достаточно большом количестве иттераций рекурсивной функции (в данном примере ф-ция test1 имеет 30738 иттераций) и возникает эта ошибка...
Какой предел иттераций, от чего он зависит лично я не знаю, хотя на простом примере наверно это можно вычислить:

Код:

[Выделить все]

(defun rec-test (a)
  (setq b a)
  (rec-test (1+ a))
; вызов (rec-test 0)

Смотрим значение переменной b. У меня оно получилось - 19975.
Ну и теперь новый вариант ф-ции rec-boundingBox - рекурсия заменена циклом, ну и небольшие изменения, направленные на увеличение скорости

Код:

[Выделить все]

(defun rec-boundingBox (/ f test test1 lst obj)
 (setq
  f (lambda (x y)
     (equal
      (mapcar 'minusp
              (vlax-curve-getFirstDeriv obj x)
      ) ;_  mapcar
      (mapcar 'minusp
              (vlax-curve-getFirstDeriv obj y)
      ) ;_  mapcar
     ) ;_  equal
    ) ;_  lambda
 ) ;_  setq
 (defun test (a b d)
  (if (= a b)
   nil
   ((lambda (r)
     (if (equal a r d)
      r
      (if (f a r)
       (test r b d)
       (test a r d)
      ) ;_  if
     ) ;_  if
    ) ;_  lambda
    (/ (+ a b) 2.)
   )
  ) ;_  if
 ) ;_  defun
 (defun test1 (a b e / temp lst)
  (setq
   temp (mapcar 'minusp
                (vlax-curve-getFirstDeriv obj a)
        ) ;_  mapcar
  ) ;_  setq
  (while
   (cond
    ((> b e) (setq lst (cons e lst)) nil)
    ((equal
      temp
      (mapcar 'minusp
              (vlax-curve-getFirstDeriv obj b)
      ) ;_  mapcar
     ) ;_  equal
     (setq b (1+ b))
    )
    (t
     (setq lst  (cons (test (1- b) b 1.0e-010) lst)
           a    b
           temp (mapcar 'minusp
                        (vlax-curve-getFirstDeriv obj a)
                ) ;_  mapcar
           b    (1+ b)
     ) ;_  setq
    )
   ) ;_  cond
  ) ;_  while
  lst
 ) ;_  defun
 (if
  (and (setq obj
             (car (entsel
                   "\nВыберите pline,spline,ellipse: "
                  ) ;_  entsel
             ) ;_  car
       ) ;_  setq
       (wcmatch (cdr (assoc 0 (entget obj)))
                "SPLINE,ELLIPSE,*LINE,CIRCLE,ARC"
       ) ;_  wcmatch
       (setq obj (vlax-ename->vla-object obj))
  ) ;_ end of and
  ((lambda (lst)
    (list (list (apply 'min (mapcar 'car lst))
                (apply 'min (mapcar 'cadr lst))
          ) ;_  list
          (list (apply 'max (mapcar 'car lst))
                (apply 'max (mapcar 'cadr lst))
          ) ;_  list
    ) ;_  list
   ) ;_  lambda
   (mapcar
    '(lambda (x)
      (vlax-curve-getPointAtParam obj x)
     ) ;_  lambda
    (cons 0.0
          (test1 0 1 (vlax-curve-getEndParam obj))
    ) ;_  cons
   ) ;_  mapcar
  )
 ) ;_  if
) ;_  defun

Do$ · 26.10.2009, 10:18

Цитата:

Сообщение от CB

иттераций

С одной "т" пишется

Цитата:

Сообщение от CB

Ну и теперь новый вариант ф-ции rec-boundingBox - рекурсия заменена циклом, ну и небольшие изменения, направленные на увеличение скорости

Сейчас значительно лучше! Даже с 3D сплайном справилась!

А вот со сплайном, полученным из сглаженной полилинии не подружилась.
И все же, метод бисекции довольно небыстр в плане сходимости. Поэтому предлагаю вариант, основанный на методе Ньютона:

Код:

[Выделить все]

(defun c:test (/ box)
  (vl-load-com)
  (setq	box
	 (Spline_getBoundingBox
	   (vlax-ename->vla-object (car (entsel "\nSelect spline:")))
	 ) ;_ end of Spline_getBoundingBox
  ) ;_ end of setq
  (setq	box
	 (list (list (cdr (assoc "Xmin" box)) (cdr (assoc "Ymin" box)))
	       (list (cdr (assoc "Xmax" box)) (cdr (assoc "Ymax" box)))
	 ) ;_ end of list
  ) ;_ end of setq
  (entmakex
    (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 4)
      (cons 70 1)
      (cons 10 (car box))
      (cons 10
	    (list (caar box) (cadr (last box)) (last (car box)))
      ) ;_ end of cons
      (cons 10 (last box))
      (cons 10
	    (list (car (last box)) (cadar box) (last (car box)))
      ) ;_ end of cons
    ) ;_ end of list
  ) ;_ end of entmakex
) ;_ end of defun





(defun Spline_getBoundingBox (obj		  /
			      fpt_list		  pt_nul_lst
			      p_list
			      _kpblc-conv-list-to-3dpoints
			     )

;;;(Spline_getBoundingBox (vlax-ename->vla-object (car (entsel "\nSpline?:"))))
;;;(("Xmin" . 353.332) ("Xmax" . 14863.7) ("Ymin" . -10403.0) ("Ymax" . -2568.36))

  (defun _kpblc-conv-list-to-3dpoints (lst / res)
				      ;|
*    Функция конвертации списка чисел в список 3-мерных точек. На основе уроков
* по рекурсиям Евгения Елпанова
*    Параметры вызова:
*	lst	список чисел
*    Примеры вызова:
(_kpblc-conv-list-to-3dpoints '(1 2 3 4 5 6)) ;-> ((1 2 3) (4 5 6))
(_kpblc-conv-list-to-3dpoints '(1 2 3 4 5))   ;-> ((1 2 3) (4 5 0.))
|;
    (cond
      ((not lst)
       nil
      )
      (t
       (setq res (cons (list (car lst)
			     (if (cadr lst)
			       (cadr lst)
			       0.
			     ) ;_ end of if
			     (if (caddr lst)
			       (caddr lst)
			       0.
			     ) ;_ end of if
		       ) ;_ end of list
		       (_kpblc-conv-list-to-3dpoints (cdddr lst))
		 ) ;_ end of cons
       ) ;_ end of setq
      )
    ) ;_ end of cond
    res
  ) ;_ end of defun

  (if (and
	(= (type obj) (quote VLA-OBJECT))
	(= (vla-get-objectname obj) "AcDbSpline")
      ) ;_ end of and
    (apply (function append)
	   (mapcar
	     (function
	       (lambda (cadrs coord)
		 (setq pt_nul_lst
			(append
			  (mapcar
			    (function
			      (lambda (y)
				(cadrs (vlax-curve-getpointatparam obj y))
			      ) ;_ end of lambda
			    ) ;_ end of function
			    (vl-remove-if
			      (function
				(lambda	(z)
				  (or (> z (apply (function max) p_list))
				      (< z (apply (function min) p_list))
				  ) ;_ end of or
				) ;_ end of lambda
			      ) ;_ end of function
			      (mapcar
				(function
				  (lambda (p / f df it)
				    (setq it 0)
				    (while (not	(or (equal f 0.0 1.0e-010)
						    (equal df 0.0 1.0e-010)
						    (> it 500)
						) ;_ end of or
					   ) ;_ end of not
				      (setq
					it (1+ it)
					f  (cadrs
					     (vlax-curve-getfirstderiv
					       obj
					       p
					     ) ;_ end of vlax-curve-getfirstderiv
					   ) ;_ end of car
					df (cadrs
					     (vlax-curve-getsecondderiv
					       obj
					       p
					     ) ;_ end of vlax-curve-getsecondderiv
					   ) ;_ end of car 
					p  (if (equal df 0.0 1.0e-010)
					     p
					     (- p (/ f df))
					   ) ;_ end of if
				      ) ;_ end of setq
				    ) ;_ end of while
				  ) ;_ end of lambda
				) ;_ end of function
				(setq p_list
				       ((lambda	(p_lst / rez otr)
					  (setq
					    p_lst (mapcar
						    (function float)
						    (vl-sort (vl-remove-if 'null p_lst)
							     (function <)
						    ) ;_ end of vl-sort
						  ) ;_ end of mapcar
					    rez	  (list (car p_lst))
					  ) ;_ end of setq
					  (while p_lst
					    (setq
					      rez   (if	(cadr p_lst)
						      (append
							rez
							(list
							  (+ (car p_lst)
							     (setq otr (/ (- (cadr p_lst)
									     (car p_lst)
									  ) ;_ end of -
									  10
								       ) ;_ end of /
							     ) ;_ end of setq
							  ) ;_ end of +
							) ;_ end of list
							(mapcar
							  (function
							    (lambda (x)
							      (+ (car p_lst) (* x otr))
							    ) ;_ end of lambda
							  ) ;_ end of function
							  '(2 3 4 5 6 7 8 9)
							) ;_ end of mapcar
							(list (cadr p_lst))
						      ) ;_ end of append
						      (append rez (list (car p_lst)))
						    ) ;_ end of if
					      p_lst (cdr p_lst)
					    ) ;_ end of setq
					  ) ;_ end of while
					  rez
					) ;_ end of lambda
					 (vl-remove-if
					   (function null)
					   (mapcar
					     (function
					       (lambda (x)
						 (vlax-curve-getparamatpoint obj x)
					       ) ;_ end of lambda
					     ) ;_ end of function
					     (setq fpt_list
						    (mapcar
						      (function
							(lambda	(x)
							  (vlax-curve-getclosestpointto
							    obj
							    x
							  ) ;_ end of vlax-curve-getclosestpointto
							) ;_ end of lambda
						      ) ;_ end of function
						      (_kpblc-conv-list-to-3dpoints
							(vlax-safearray->list
							  (vlax-variant-value
							    (vla-get-controlpoints obj)
							  ) ;_ end of vlax-variant-value
							) ;_ end of vlax-safearray->list
						      ) ;_ end of _kpblc-conv-list-to-3dpoints
						    ) ;_ end of mapcar
					     ) ;_ end of setq
					   ) ;_ end of mapcar
					 ) ;_ end of vl-remove-if
				       )
				) ;_ end of setq
			      ) ;_ end of mapcar
			    ) ;_ end of vl-remove-if
			  ) ;_ end of mapcar
			  (list
			    (cadrs (car fpt_list))
			    (cadrs (last fpt_list))
			  ) ;_ end of list
			) ;_ end of append
		 ) ;_ end of setq
		 (list (cons (strcat coord "min")
			     (apply (function min) pt_nul_lst)
		       ) ;_ end of cons
		       (cons (strcat coord "max")
			     (apply (function max) pt_nul_lst)
		       ) ;_ end of cons
		 ) ;_ end of list
	       ) ;_ end of lambda
	     ) ;_ end of function
	     (list car cadr) ;_ for 3D: (list car cadr caddr)
	     (list "X" "Y") ;_ for 3D: (list "X" "Y" "Z")
	   ) ;_ end of mapcar
    ) ;_ end of apply
  ) ;_ end of if
) ;_ end of defun

Замечания и предложения приветствуются!

P.S. Выложенный ранее код не прошел тестирования

Исправил, работать стало помедленнее, но корректно.

CB · 26.10.2009, 15:59

>Do$
1. На сглаженной полилинии ф-я test выдает

Код:

[Выделить все]

 
Command: test
Select spline:; error: bad DXF group: (10 nil nil)

2.

Цитата:

А вот со сплайном, полученным из сглаженной полилинии не подружилась.

Есть такое дело. Не понятно почему для для сглаженной полилинии не работает такой код:

Код:

[Выделить все]

 
(vlax-curve-getPointAtParam obj (vlax-curve-getEndParam obj))

хотя

Код:

[Выделить все]

 
(vlax-curve-getEndPoint obj)

выдает нужную точку...
Исправленный вариант

Код:

[Выделить все]

(defun rec-boundingBox (/ f test test1 lst obj)
 (setq
  f (lambda (x y)
     (equal
      (mapcar 'minusp
              (vlax-curve-getFirstDeriv obj x)
      ) ;_  mapcar
      (mapcar 'minusp
              (vlax-curve-getFirstDeriv obj y)
      ) ;_  mapcar
     ) ;_  equal
    ) ;_  lambda
 ) ;_  setq
 (defun test (a b d)
  (if (= a b)
   nil
   ((lambda (r)
     (if (equal a r d)
      r
      (if (f a r)
       (test r b d)
       (test a r d)
      ) ;_  if
     ) ;_  if
    ) ;_  lambda
    (/ (+ a b) 2.)
   )
  ) ;_  if
 ) ;_  defun
 (defun test1 (a b e / temp lst)
  (setq
   temp (mapcar 'minusp
                (vlax-curve-getFirstDeriv obj a)
        ) ;_  mapcar
  ) ;_  setq
  (while
   (cond
    ((> b e) nil)
    ((equal
      temp
      (mapcar 'minusp
              (vlax-curve-getFirstDeriv obj b)
      ) ;_  mapcar
     ) ;_  equal
     (setq b (1+ b))
    )
    (t
     (setq lst  (cons (test (1- b) b 1.0e-010) lst)
           a    b
           temp (mapcar 'minusp
                        (vlax-curve-getFirstDeriv obj a)
                ) ;_  mapcar
           b    (1+ b)
     ) ;_  setq
    )
   ) ;_  cond
  ) ;_  while
  lst
 ) ;_  defun
 (if
  (and (setq obj
             (car (entsel
                   "\nВыберите pline,spline,ellipse: "
                  ) ;_  entsel
             ) ;_  car
       ) ;_  setq
       (wcmatch (cdr (assoc 0 (entget obj)))
                "SPLINE,ELLIPSE,*LINE,CIRCLE,ARC"
       ) ;_  wcmatch
       (setq obj (vlax-ename->vla-object obj))
  ) ;_ end of and
  ((lambda (lst)
    (list (list (apply 'min (mapcar 'car lst))
                (apply 'min (mapcar 'cadr lst))
          ) ;_  list
          (list (apply 'max (mapcar 'car lst))
                (apply 'max (mapcar 'cadr lst))
          ) ;_  list
    ) ;_  list
   ) ;_  lambda
   (append
    (list (vlax-curve-getStartPoint obj)
          (vlax-curve-getEndPoint obj)
    ) ;_  list
    (mapcar
     '(lambda (x)
       (vlax-curve-getPointAtParam obj x)
      ) ;_  lambda
     (cons 0.0
           (test1 0 1 (vlax-curve-getEndParam obj))
     ) ;_  cons
    ) ;_  mapcar
   ) ;_  append
  )
 ) ;_  if
) ;_  defun
;;;Проверка
(progn
  (vl-cmdf "_rectang")
  (apply 'vl-cmdf (rec-boundingBox))
) ;_ end of progn

Do$ · 26.10.2009, 16:22

Цитата:

Сообщение от CB

>Do$
1. На сглаженной полилинии ф-я test выдает

Код:

Command: test
Select spline:; error: bad DXF group: (10 nil nil)

да ну ее, эту сглаженную

на ней vla-getboundingbox и так корректно работает, поэтому функцию делал только для сплайна: в начале идет проверка, если выбранный объект не сплайн - выдает nil. Ну а вспомогательная программа отрисовки естессна ругается, что вместо координат nil получает.

zenon · 02.11.2009, 15:22

А рабочая версия программы для распечатки по объекту уже есть или как?

Do$ · 02.11.2009, 17:12

Все наработки этой темы скидал в кучу, особо не проверял (Нужно заменить <Имя устройства вывода> на свой принтер, после загрузки запускать командой object_print):

Код:

[Выделить все]

(defun c:object_print (/ ent box xy1 xy2 orientation a)

  (defun GetBoundingBox	(en / obj minpt maxpt)
    (if	(= (type en) 'ENAME)
      (progn
	(setq obj (vlax-ename->vla-object en))
	(vla-getboundingbox obj 'minpt 'maxpt)
	(list
	  (trans (vlax-safearray->list minpt) 0 1)
	  (trans (vlax-safearray->list maxpt) 0 1)
	) ;_ end of list
      ) ;_ end of progn
    ) ;_endof if progn 
  ) ;_endof defun

  (defun GetBoundingBox_dynblock (ent / lst min_point max_point)
;;;  (if (and (= (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 =
    (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 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
	  min_point (mapcar
		      (function +)
		      (mapcar
			(function
			  (lambda (f)
			    (apply
			      (function min)
			      (mapcar f
				      (mapcar
					(function
					  (lambda (x) (cdr (assoc "min" x)))
					) ;_ 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
		      (vlax-safearray->list
			(vlax-variant-value (vla-get-insertionpoint ent))
		      ) ;_ end of vlax-safearray->list
		    ) ;_ end of mapcar
	  max_point (mapcar
		      (function +)
		      (mapcar
			(function
			  (lambda (f)
			    (apply
			      (function max)
			      (mapcar f
				      (mapcar
					(function
					  (lambda (x) (cdr (assoc "max" x)))
					) ;_ 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
		      (vlax-safearray->list
			(vlax-variant-value (vla-get-insertionpoint ent))
		      ) ;_ end of vlax-safearray->list
		    ) ;_ end of mapcar
;;;            lst       (list (cons "min" min_point) (cons "max" max_point))
	  lst	    (list min_point max_point)
    ) ;_ end of setq
;;;  ) ;_ end of progn
;;;) ;_ end of if
;;;lst
  ) ;_ end of defun



  (defun Spline_getBoundingBox (obj	    /		c_pt_lst
				cd_pt_lst   ex_pt_lst	cls_pt_lst
				p_lst	    divid	spline_extr
			       )


    (defun spline_extr (obj pst / it)
		       ;|
Функция поиска экстремума сплайна на основе метода Ньютона.
Исходные параметры:
 obj - VLA-OBJECT или ENAME вида: #<VLA-OBJECT IAcadSpline 05548644> или <Entity name: 7ef65fb8>
 pst - параметр сплайна в точке начального приближения к экстремуму, действительное число

Возвращаемые значения:
 Список вида: (параметр1 параметр2 параметр3)
 параметр 1(2,3) может быть действительным положительным числом или nil, если экстремум
 не был найден (метод не сошелся).
 Примеры: (137.199 173.728 147.543)
	  (nil nil 219.258)

Пример вызова:
(spline_extr
  (setq	obj
	 (vlax-ename->vla-object
	   (car (entsel "\nВыберите сплайн:"))
	 ) ;_ end of vlax-ename->vla-object
  ) ;_ end of setq
  (vlax-curve-getParamAtPoint
    obj
    (getpoint "\nУкажите точку на сплайне:")
  ) ;_ end of vlax-curve-getParamAtPoint
) ;_ end of spline_extr
|;
      (if pst
	(mapcar
	  (function
	    (lambda (cadrs / f df p)
	      (setq it 0
		    p  pst
	      ) ;_ end of setq
	      (while (not (or (equal f 0.0 1.0e-008)
			      (equal df 0.0 1.0e-008)
			      (> it 10)
			  ) ;_ end of or
		     ) ;_ end of not
		(setq it (1+ it)
		      f	 ((eval cadrs) (vlax-curve-getfirstderiv obj p))
		      df ((eval cadrs) (vlax-curve-getsecondderiv obj p))
		      p	 (if (equal df 0.0 1.0e-008)
			   p
			   (- p (/ f df))
			 ) ;_ end of if
		) ;_ end of setq
	      ) ;_ end of while
	      (if (or (< p (vlax-curve-getStartParam obj))
		      (> p (vlax-curve-getEndParam obj))
		      (> it 10)
		  ) ;_ end of or
		nil
		p
	      ) ;_ end of if
	    ) ;_ end of lambda
	  ) ;_ end of function
	  (list car cadr caddr)
	) ;_ end of mapcar
      ) ;_ end of if
    ) ;_ end of defun

    (defun divid (pt1 pt2 n)
		 ;|
    Функция нахождения точек, делящих отрезок
    на заданное количество равных частей.

Исходные параметры:
    pt1 - начало отрезка
    pt2 - конец отрезка
    n - количество частей

Пример вызова:
    (divid '(0.0 0.0 0.0) '(15.0 15.0 15.0) 3)
    (divid '(0.0 0.0) '(12.0 12.0) 4)

Возвращаемое значение - список точек вида:
    ((5.0 5.0 5.0) (10.0 10.0 10.0))
    ((3.0 3.0) (6.0 6.0) (9.0 9.0))
|;
      (mapcar
	'(lambda (c)
	   (mapcar '(lambda (a b) (+ (* c (/ (- a b) n)) b)) pt2 pt1)
	 ) ;_ end of lambda
	(
	 (lambda (d / rez)
	   (repeat (setq d (1- d))
	     (setq rez (cons d rez)
		   d   (1- d)
	     ) ;_ end of setq
	   ) ;_ end of repeat
	   rez
	 ) ;_ end of lambda
	  n
	)
      ) ;_ end of mapcar
    ) ;_ end of defun

    (if	(= (type obj) 'ENAME)
      (setq obj (vlax-ename->vla-object obj))
    ) ;_ end of if
    (setq c_pt_lst   (mapcar
		       '(lambda	(x)
			  (vlax-safearray->list
			    (vlax-variant-value
			      (vla-getcontrolpoint obj x)
			    ) ;_ end of vlax-variant-value
			  ) ;_ end of vlax-safearray->list
			) ;_ end of lambda
		       (
			(lambda	(/ n lst)
			  (repeat
			    (1-	(setq
				  n (1- (vla-get-NumberOfControlPoints obj))
				) ;_ end of setq
			    ) ;_ end of 1-
			     (setq
			       n   (1- n)
			       lst (cons n lst)
			     ) ;_ end of setq
			  ) ;_ end of repeat
			  lst
			) ;_ end of lambda
		       )
		     ) ;_ end of mapcar


	  cd_pt_lst  (
		      (lambda (lst / rez)
			(while lst
			  (if (cadr lst)
			    (setq
			      rez (append
				    rez
				    (cons (car lst)
					  (divid (car lst) (cadr lst) 3)
				    ) ;_ end of cons
				  ) ;_ end of append
			    ) ;_ end of setq
			    (setq rez (append rez lst))
			  ) ;_ end of if
			  (setq lst (cdr lst))
			) ;_ end of while
			rez
		      ) ;_ end of lambda
		       c_pt_lst
		     )
	  cls_pt_lst (mapcar
		       '(lambda	(pt)
			  (vlax-curve-getclosestpointto obj pt)
			) ;_ end of lambda
		       cd_pt_lst
		     ) ;_ end of mapcar
	  p_lst	     (vl-remove-if
		       'not
		       (apply
			 'append
			 (mapcar (function (lambda (x)
					     (spline_extr
					       obj
					       (vlax-curve-getParamAtPoint obj x)
					     ) ;_ end of spline_extr
					   ) ;_ end of lambda
				 ) ;_ end of function
				 cls_pt_lst
			 ) ;_ end of mapcar
		       ) ;_ end of apply
		     ) ;_ end of vl-remove-if
	  ex_pt_lst  (append
		       (list
			 (vlax-curve-getStartPoint obj)
			 (vlax-curve-getEndPoint obj)
		       ) ;_ end of list
		       (mapcar
			 (function
			   (lambda (p) (vlax-curve-getPointAtParam obj p))
			 ) ;_ end of function
			 p_lst
		       ) ;_ end of mapcar
		     ) ;_ end of append
    ) ;_ end of setq
    (mapcar
      (function
	(lambda	(mins)
	  (mapcar
	    (function (lambda (cadrs)
			(apply (function mins)
			       (mapcar (function cadrs) ex_pt_lst)
			) ;_ 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
  ) ;_ end of defun


;;;(princ "Выберите объект для печати")
;;;(setq box (GetBoundingBox (car (entsel))))
  (vl-load-com)
  (vla-StartUndoMark
    (vla-get-ActiveDocument (vlax-get-acad-object))
  ) ;_ end of vla-StartUndoMark
  (if (= (type (setq ent
		      (vl-catch-all-apply
			(function
			  (lambda ()
			    (car
			      (entsel "\nВыберите объект для печати <Отмена> : ")
			    ) ;_ end of car
			  ) ;_ end of lambda
			) ;_ end of function
		      ) ;_ end of vl-catch-all-apply
	       ) ;_ end of setq
	 ) ;_ end of type
	 'ename
      ) ;_ end of =
    (progn
      (cond
	((and
	   (= (cdr (assoc 0 (entget ent))) "INSERT")
	   (vlax-property-available-p
	     (vlax-ename->vla-object ent)
	     'isdynamicblock
	   ) ;_ end of vlax-property-available-p
	   (equal (vla-get-isdynamicblock (vlax-ename->vla-object ent))
		  :vlax-true
	   ) ;_ end of equal
	 ) ;_ end of and
	 (setq box (GetBoundingBox_dynblock ent))
	)
	((= (cdr (assoc 0 (entget ent))) "SPLINE")
	 (setq box (Spline_getBoundingBox ent))
	)
	(T (setq box (GetBoundingBox ent)))
      ) ;_ end of cond




					; список из координат минимума и максимума габаритов выбранного объекта
      (setq xy1 (car box))		; координаты для определения области печати, xy1 - левая нижняя, xy2 - правая верхняя 
      (setq xy2 (car (cdr box)))
      (setq a (angle xy1 xy2))		;угол для вычисления ориентации листа
;;; Ориентация листа: если угол в диапазоне 45...135 или 225...315 то портрет, иначе - альбом
      (if (or (and (> a (* pi 0.25)) (< a (* pi 0.75)))
	      (and (> a (* pi 1.25)) (< a (* pi 1.75)))
	  ) ;_ end of or
	(setq orientation "Portrait")
	(setq orientation "Landscape")
      ) ;_ end of if
      (command "_.plot"	       "_Yes"	       "model"
					; Имя листа или [?] <Модель>: 
	       "<Имя устройства вывода>.pc3" ;Имя устройства вывода 
	       "A4"			;Формат листа бумаги
	       "Millimeters"		;Единицы измерения размеров листа
	       orientation		;Ориентация чертежа
	       "_No"			;Перевернуть чертеж?
	       "_Window"		;Печатаемая область
	       xy1			;Первая точка окна 
	       xy2			;Вторая точка окна 
	       "_fit"			;[Вписать]
	       "_center"		;Смещение от начала (x,y) или [Центрировать]
	       "_yes"			;Учитывать стили печати?
	       "monochrome.ctb"		;Имя таблицы стилей печати
	       "_yes"			;Учитывать веса линий?
	       "As displayed"		;Режим вывода раскрашенных ВЭ
	       "_No"			;Запись чертежа в файл
	       "_yes"			;Сохранить изменения параметров листа
	       "_yes"			;Перейти к печати
	      ) ;_ end of command
 ;_ end of command
 ;_ end of command
    ) ;_ end of progn
  ) ;_ end of if
  (vla-EndUndoMark
    (vla-get-ActiveDocument (vlax-get-acad-object))
  ) ;_ end of vla-EndUndoMark
) ;_ end of defun

zenon · 03.11.2009, 15:38

Спасибо тебе добрый человек

Колька · Регистрация: 26.07.2009

Парни я честно говоря не вник о чём писали ранее, поэтому извените если повторился в чём то. Вот мой код для печати по динамическим блокам из 2-х точек. У меня всё работает. Первые 2 функции для отображения этих самых точек, последние (px и py) вспомогательные. Основной код NPr. Покритикуйте плиз, хочеться оптимизировать свой процесс програмирования

Блок с точками:
Print_block.dwg

Код:

[Выделить все]

 
(defun C:NPointV (/)
	(if (/= (getvar "_pdmode") 35) (setvar "_pdmode" 35))
	(if (/= (getvar "_pdsize") -1) (setvar "_pdsize" -1))
)
(defun C:NPointInv (/)
	(if (/= (getvar "_pdmode") 0) (setvar "_pdmode" 0))
	(if (/= (getvar "_pdsize") 0) (setvar "_pdsize" 0))
)

(defun C:NPr ( / i nabor text x y p1 p2 obj)
	(vl-load-com)	
	(command "_ucs" "_world")
	(setq nabor (ssget '((0 . "INSERT"))))
	(setq i (- (sslength nabor) 1))
	(while (>= i 0)
		(setq text (vlax-get-property (vlax-ename->vla-object (ssname nabor i)) 'EffectiveName))
		(if (/= text "Ramka_dlya_pechati") (ssdel (ssname nabor i) nabor))
		(setq i (- i 1))
	)	
	(setq i 0)	
	(while (< i (sslength nabor))		
		(setq obj (vlax-ename->vla-object (ssname nabor i)))
		(setq p1 (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'InsertionPoint))))		
		(setq x (vlax-variant-value (vlax-get-property (car (vlax-safearray->list (vlax-variant-value (vla-getdynamicblockproperties obj)))) 'value)))
                      (setq y (vlax-variant-value (vlax-get-property (car (cdr (vlax-safearray->list (vlax-variant-value (vla-getdynamicblockproperties obj))))) 'value)))
		(setq p2 (py y (px x p1) ) )		
		(if (> x y) (setq text "Landscape") (setq text "Portrait"))
		(command "_plot" "_y" "" "ВАШ ПРИНТЕР" "A3" "_Millimeters" text "_No" "_Window" p1 p2
		"_Fit" "_center" "_Yes" "monochrome.ctb" "_Yes" "_As displayed" "_N" "_N" "_Y")
		(setq i (+ i 1))	
	)	
)

	(defun px (x pt) (cons (+ x (nth 0 pt)) (cons (nth 1 pt) (cons (nth 2 pt) (cdddr pt)))))
	(defun py (y pt) (cons (nth 0 pt) (cons (+ y (nth 1 pt)) (cons (nth 2 pt) (cdddr pt)))))

Кстати она отличаеться тем что расставив блоки по всем чертежам можно не заморачиваясь выделить их все и распечатать, прога сама отыщет блоки.

Кулик Алексей aka kpblc · 06.11.2009, 13:38

Проблема номер раз: не будет работать в официальных локализациях.
Проблема номер два: печать сделана под определенный плоттер и на другой машине, скорее всего, работать не будет.

zenon · 06.11.2009, 13:45

Колька код из поста 55 печатает по выбору объекта пример см пост 1. То бишь просто выбираешь объект, а прога определяет сама границы печати и отправляет на принтер. Все настройки делаются в самой программе, тама все понятно.

Колька · 06.11.2009, 13:46

В русской версии не пробовал, но думаю нижние слеши спасут. А насчёт определённого плоттера, так ведь здесь все пишут под определённый, там где нужно поменять так и написанно "ВАШ ПРИНТЕР". Да кстати там же можно и бумагу менять и др. параметры.

Это я понял, только ведь если много чертежей в моделе то придётся помучаться выбирая объекты, а здесь просто всё выделяем и чепятаем

Ладно, не понравилась так фиг с ней. У меня по этой теме вопрос. Кто нибудь знает как вытащить имена принтеров в лиспе? А то при установки проги приходиться их вручную забивать.

Do$ · 06.11.2009, 22:50

Цитата:

Сообщение от Колька

Это я понял, только ведь если много чертежей в моделе то придётся помучаться выбирая объекты, а здесь просто всё выделяем и чепятаем

Все равно надо сперва твои точки расставить по чертежу

Кстати, точками не очень наглядно - не видно, что попало в границы печати, а что нет. Думаю, что лучше динамический блок делать в виде рамки.

Цитата:

Сообщение от Колька

Кто нибудь знает как вытащить имена принтеров в лиспе?

Код:

[Выделить все]

(vlax-safearray->list
  (vlax-variant-value
    (vla-GetPlotDeviceNames
      (vla-get-ActiveLayout
	(vla-get-ActiveDocument (vlax-get-acad-object))
      ) ;_ end of vla-get-ActiveLayout
    ) ;_ end of vla-GetPlotDeviceNames
  ) ;_ end of vlax-variant-value
) ;_ end of vlax-safearray->list

Колька · 09.11.2009, 00:31

Цитата:

Сообщение от Do$

Все равно надо сперва твои точки расставить по чертежу Кстати, точками не очень наглядно - не видно, что попало в границы печати, а что нет. Думаю, что лучше динамический блок делать в виде рамки.

Я это делал чисто для себя и колег, был трабл с распечаткой чертежей, а они все в стандартных рамках. Точки был самый оптимальный для использования в коллективе вариант, и незаметно и полезно

Спасибо за код, завтра на работе попробую!

Колька · 10.11.2009, 13:05

Do$ спасибо, очень помог. Дописал код так что бы можно было в диалоговом окне выбирать из существующих принтеров и выбирать формат бумаги. Если кому надо могу выложить.

Do$ · 10.11.2009, 13:52

Мне будет интересно взглянуть, если в ней задаются настройки печати без командных методов.

Колька · 10.11.2009, 14:11

Сначала нужно окошко создать.
Это файл PrintW.dcl :

Код:

[Выделить все]

//Диалоговое окно
 PrintW : dialog {label = "Окно выбора" ; 
  :list_box{label = "Список";
    key="lb_Subjects";
    multiple_select = false;
    fixed_width_font=true;
    width=32;
    height=20;
  }//конец list_box
    :row{
      fixed_width=true;
      alignment = right; 
    ok_cancel;
    }    //конец row
   }  //конецPrintW

его поместить туда куда прописан путь поиска (например C:\Program Files\AutoCAD 2009\support) или прописать путь к папке с этим файлом.

Далее лисп:

Код:

[Выделить все]

(defun C:NPr ( / i nabor text x y p1 p2 obj l_pr l_paper printer paper lay)
	(vl-load-com)
	(setq l_pr (vlax-safearray->list (vlax-variant-value (vla-GetPlotDeviceNames (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object)))))))  
	(setq printer (dialog_n l_pr))  
	(vla-put-ConfigName  (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object)))  printer)
	(setq l_paper 
		(mapcar	'(lambda (a) (vla-GetLocaleMediaName lay a))
			(vlax-safearray->list
			  (vlax-variant-value
			    (vla-GetCanonicalMediaNames
	 		     (setq lay	(vla-get-ActiveLayout
					  (vla-get-ActiveDocument (vlax-get-acad-object))
					) ;_ end of vla-get-ActiveLayout
			      ) ;_ end of setq
			    ) ;_ end of vla-GetCanonicalMediaNames
			  ) ;_ end of vlax-variant-value
			) ;_ end of vlax-safearray->list
		) ;_ end of mapcar	
	)   
  	(setq paper (dialog_n l_paper))
  	(command "_ucs" "_world")
	(setq nabor (ssget '((0 . "INSERT"))))
	(setq i (- (sslength nabor) 1))	
	(while (>= i 0)
		(setq text (vlax-get-property (vlax-ename->vla-object (ssname nabor i)) 'EffectiveName))
		(if (/= text "Ramka_dlya_pechati") (ssdel (ssname nabor i) nabor) )
		(setq i (- i 1))
	)	
	(setq i 0)	
	(while (< i (sslength nabor))		
		(setq obj (vlax-ename->vla-object (ssname nabor i)))		
		(setq p1 (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'InsertionPoint))))		
		(setq x (vlax-variant-value (vlax-get-property (car (vlax-safearray->list (vlax-variant-value (vla-getdynamicblockproperties obj)))) 'value)))
		(setq y (vlax-variant-value (vlax-get-property (car (cdr (vlax-safearray->list (vlax-variant-value (vla-getdynamicblockproperties obj))))) 'value)))
		(setq p2 (py y (px x p1) ) )		
		(if (> x y) (setq text "_Landscape") (setq text "_Portrait"))
		(command "_plot" "_y" "" printer paper "_Millimeters" text "_No" "_Window" p1 p2  "_Fit" "_center" "_Yes" "monochrome.ctb" "_Yes" "_As" "_N" "_N" "_Y") 
		(setq i (+ i 1))	
	)	
)
	(defun px (x pt) (cons (+ x (nth 0 pt)) (cons (nth 1 pt) (cons (nth 2 pt) (cdddr pt)))))
	(defun py (y pt) (cons (nth 0 pt) (cons (+ y (nth 1 pt)) (cons (nth 2 pt) (cdddr pt)))))
( defun NPrinters ( / ) 
	(print (vlax-safearray->list (vlax-variant-value (vla-GetPlotDeviceNames (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object)))))))
)

(defun dialog_n (li / rec_List act )
   (vl-load-com)
  (defun rem_Data( / ind_list cnt item)
    (setq rec_List(list))
    (setq ind_list(get_tile "lb_Subjects"))
    (setq cnt 1)
    (while (setq item (read ind_list))
      (setq rec_List(append rec_List (list (nth item vlb_Subjects))))
      (while (and (/= " " (substr ind_list cnt 1)); пропуск пустых записей
        (/= "" (substr ind_list cnt 1)); пропуск нулевых записей
     ); end while 2
    (setq cnt (+ cnt 1))
    ); end while 1
     (setq ind_list (substr ind_list cnt));формирование списка
   );end while 1
  );end rem_Data
 (setq vlb_Subjects li)

(setq dcl_id (load_dialog "PrintW.dcl"))
(if (not (new_dialog "PrintW" dcl_id))(exit)); end if
  (start_list "lb_Subjects")
  (mapcar 'add_list vlb_Subjects)
  (end_list)
(action_tile "cancel" "(setq act nil)(done_dialog)")
(action_tile "accept" "(setq act T)(rem_Data)(done_dialog)")
(start_dialog)      ;Показать Диалоговое окно
(unload_dialog dcl_id)  ;Закрыть Диалоговое окно
(if (= act nil)
    (princ "\n \n ...ЗАДАНИЕ ОТМЕНЕНО. \n ")
)  ; конец if
(if (= act T)
   (progn 
      (if (= rec_List nil)
      (princ "\n ...Вы не выбрали принтер ")
      (car rec_List)     
    ); end if 
   ); end progn
); end if
)

Функцию dialog_n честно стащил с какого-то инет учебника

JokerrSergh · 12.11.2009, 11:33

Колька, в 2007 русском автокаде не работает твоя програмка.
пишет:
Команда: npr
; ошибка: завершить / выйти прервать

Колька · 12.11.2009, 11:36

ща проверю

Кулик Алексей aka kpblc · 12.11.2009, 11:41

А чего там проверять? Я уже говорил, что в официальных локализация этот код работать не будет. И причину указывал, насколько я помню...

Колька · 12.11.2009, 11:43

да нет, всё проще, файл PrintW.pcl не подцепился. JokerrSergh вы проверяли путь к этому файлу?

JokerrSergh · 12.11.2009, 11:44

может я чего не так делаю?
сначала запихал файл PrintW.pcl в C:\Program Files\AutoCAD 2007\Support
и прописал в автокаде (путь доступа к вспомогательным файлам) путь к папке с этим файлом. Подгрузил в автокаде лисп NPr.lsp
Для пробы взял динамический блок - лист формата А3 (горизонтальный).
Вставил твой блок с точками "Print_block" и поставил точки по углам этого листа А3. Ввел в ком. строке NPr и ничего не произошло

Колька · 12.11.2009, 11:45

а в файле PrintW.pcl правельный код?

JokerrSergh · 12.11.2009, 11:48

код тупо скопировал из поста 65...
Сейчас скопировал код из файла на своем компе
//Диалоговое окно
PrintW : dialog {label = "Окно выбора" ;
:list_box{label = "Список";
key="lb_Subjects";
multiple_select = false;
fixed_width_font=true;
width=32;
height=20;
}//конец list_box
:row{
fixed_width=true;
alignment = right;
ok_cancel;
} //конец row
} //конецPrintW
Может я путь не там прописал? Где в автокаде его надо прописывать?

Nike · 12.11.2009, 11:50

Цитата:

Сообщение от Колька

а в файле PrintW.pcl правельный код?

в файле PrintW.pcl не правильное расширение. Правильно - PrintW.dcl

Колька · 12.11.2009, 11:52

На вложенной картинке показанно, там у меня лежит файл PrintW.dcl

тьфу блин! Nike пасибо тебе друг!

и кстати я подправил сам лисп добавил в него нижние слеши. JokerrSergh скопируй код ещё раз

JokerrSergh · 12.11.2009, 11:56

Цитата:

Сообщение от Nike

в файле PrintW.pcl не правильное расширение. Правильно - PrintW.dcl

Расширение исправил. Путь к файлу проверил.
Запускаю прогу, пишет:

Команда: npr
Неизвестная команда "UCS". Для вызова справки нажмите F1.
Неизвестная команда "WORLD". Для вызова справки нажмите F1.

Выберите объекты: найдено: 1

Выберите объекты:
Неизвестная команда "PLOT". Для вызова справки нажмите F1.
Неизвестная команда "Y". Для вызова справки нажмите F1.
Неизвестная команда "NPR". Для вызова справки нажмите F1.
Неизвестная команда "XEROX WORKCENTRE PRO 133 PCL 6". Для вызова справки
нажмите F1.
Неизвестная команда "A3". Для вызова справки нажмите F1.
Неизвестная команда "MILLIMETERS". Для вызова справки нажмите F1.
Неизвестная команда "LANDSCAPE". Для вызова справки нажмите F1.
Неизвестная команда "NO". Для вызова справки нажмите F1.
Неизвестная команда "WINDOW". Для вызова справки нажмите F1.
Неизвестная команда "FIT". Для вызова справки нажмите F1.
Неизвестная команда "CENTER". Для вызова справки нажмите F1.
Неизвестная команда "YES". Для вызова справки нажмите F1.
Неизвестная команда "MONOCHROME.CTB". Для вызова справки нажмите F1.
Неизвестная команда "YES". Для вызова справки нажмите F1.
Неизвестная команда "AS DISPLAYED". Для вызова справки нажмите F1.
Неизвестная команда "N". Для вызова справки нажмите F1.
Неизвестная команда "N". Для вызова справки нажмите F1.
Неизвестная команда "Y". Для вызова справки нажмите F1.

Колька · 12.11.2009, 11:57

вот как раз из-за нижних слешев, щас всё исправленно

Nike · 12.11.2009, 12:00

Цитата:

Сообщение от JokerrSergh

Расширение исправил. Путь к файлу проверил.
Запускаю прогу, пишет:

Команда: npr
Неизвестная команда "UCS". Для вызова справки нажмите F1.
Неизвестная команда "WORLD". Для вызова справки нажмите F1.

Крыс же предупреждал:

Цитата:

Сообщение от Кулик Алексей aka kpblc

А чего там проверять? Я уже говорил, что в официальных локализация этот код работать не будет.

JokerrSergh · 12.11.2009, 12:03

Выбрал принтер, затем формат листа...
Колька, а что выбирать нужно на запрос ВЫБЕРИТЕ ОБЪЕКТЫ?

Колька · 12.11.2009, 12:05

нужно выбрать все листы которые хочешь распечатать(там предварительно должны стоять точки). только подожди, я щас на локализованной версии её домучаю, должно получится

JokerrSergh · 12.11.2009, 12:06

жду
А если у меня один лист А3 горизонтальный и я его обрамил этими точками. Выделять нужно все объекты, которые попадают в рамку листа?
И сразу второй вопрос:
На каждый лист нужно каждый раз точки ставить, или можно все листы одним блоком точки обрамить?

Колька · 12.11.2009, 12:12

важно тока что бы точки выбрались, можно только секущей рамкой задеть. Теперь всё работает, проверенно!

JokerrSergh · 12.11.2009, 12:21

не работает

Команда: npr

Выберите объекты: Противоположный угол: найдено: 7

Выберите объекты: Противоположный угол: найдено: 0, всего: 7

Выберите объекты:
Неизвестная команда "MILLIMETERS". Для вызова справки нажмите F1.
Неизвестная команда "LANDSCAPE". Для вызова справки нажмите F1.
Неизвестная команда "NO". Для вызова справки нажмите F1.
Неизвестная команда "WINDOW". Для вызова справки нажмите F1.
Неизвестная команда "FIT". Для вызова справки нажмите F1.
Неизвестная команда "CENTER". Для вызова справки нажмите F1.
Неизвестная команда "YES". Для вызова справки нажмите F1.
Неизвестная команда "MONOCHROME.CTB". Для вызова справки нажмите F1.
Неизвестная команда "YES". Для вызова справки нажмите F1.
Неизвестная команда "AS". Для вызова справки нажмите F1.
Неизвестная команда "N". Для вызова справки нажмите F1.
Неизвестная команда "N". Для вызова справки нажмите F1.
Неизвестная команда "Y". Для вызова справки нажмите F1.

Колька · 12.11.2009, 12:28

Я лисп поменял теперь должно быть "_MILLIMETERS" и "_LANDSCAPE" и т.д.
перезапусти лисп. У меня всё работает и в англ и в рус.

ну как? получилось?

JokerrSergh · 12.11.2009, 12:38

все равно не хочет...

Команда: npr

Выберите объекты: Противоположный угол: найдено: 7

Выберите объекты:
Неизвестная команда "MILLIMETERS". Для вызова справки нажмите F1.
Неизвестная команда "LANDSCAPE". Для вызова справки нажмите F1.
Неизвестная команда "NO". Для вызова справки нажмите F1.
Неизвестная команда "WINDOW". Для вызова справки нажмите F1.
Неизвестная команда "FIT". Для вызова справки нажмите F1.
Неизвестная команда "CENTER". Для вызова справки нажмите F1.
Неизвестная команда "YES". Для вызова справки нажмите F1.
Неизвестная команда "MONOCHROME.CTB". Для вызова справки нажмите F1.
Неизвестная команда "YES". Для вызова справки нажмите F1.
Неизвестная команда "AS". Для вызова справки нажмите F1.
Неизвестная команда "N". Для вызова справки нажмите F1.
Неизвестная команда "N". Для вызова справки нажмите F1.
Неизвестная команда "Y". Для вызова справки нажмите F1.
1

файлик прилагаю

Колька · 12.11.2009, 12:49

У меня распечаталась. Будем искать в чём косяк. набери в командной строке

Код:

[Выделить все]

(command "_plot" "_y" "")

и пришли результат

JokerrSergh · 12.11.2009, 13:05

Команда: (command "_plot" "_y" "")
nil
Имя устройства вывода или [?] <Нет>:

Колька · 12.11.2009, 13:18

АА понял, мой косяк. у тебя на принтере бумага по другому называеться.
можешь точно прислать те форматы которыми ты пользуешься я тебе их пропишу.

набери (command "_plot" "_y" "" "XEROX WORKCENTRE PRO 133 PCL 6" "?") и пришли результат

JokerrSergh · 12.11.2009, 13:36

Команда: (command "_plot" "_y" "" "XEROX WORKCENTRE PRO 133 PCL 6" "?")

Доступные форматы носителя.
"Польз. 20 (210x297 мм)"
"Польз. 19 (210x297 мм)"
"Польз. 18 (210x297 мм)"
"Польз. 17 (210x297 мм)"
"Польз. 16 (210x297 мм)"
"Польз. 15 (210x297 мм)"
"Польз. 14 (210x297 мм)"
"Польз. 13 (210x297 мм)"
"Польз. 12 (210x297 мм)"
"Польз. 11 (210x297 мм)"
"Польз. 10 (210x297 мм)"
"Польз. 9 (210x297 мм)"
"Польз. 8 (210x297 мм)"
"Польз. 7 (210x297 мм)"
"Польз. 6 (210x297 мм)"
"Польз. 5 (210x297 мм)"
"Польз. 4 (210x297 мм)"
"Польз. 3 (210x297 мм)"
"Польз. 2 (210x297 мм)"
"Польз. 1 (210x297 мм)"
"16K (195 x 270 мм)"
"16K (194 x 267 мм)"
"8K (270 x 390 мм)"
"8K (267 x 388 мм)"
"Обложка Letter (9 x 11")"
"Обложка А4 (223 х 297 мм)"
"Youkei 0 (235 х 120 мм)"
"Открытка с маркой горизонтальна\"
"Японска\ открытка (100x148 мм)"
"Photo 2L (5 x 7")"
"Postcard (4 x 6")"
"11 x 15" (279,4 x 381,0 мм)"
"215 x 315 мм (8,46 x 12,4")"
"8 x 10" (203,2 x 254,0 мм)"
"С4 (229 х 324 мм)"
"C5 (162 x 229 мм)"
"DL (110 x 220 мм)"
"Com 10 (4.125 x 9.5")"
"Monarch (3.875 x 7.5")"
"Ledger (11 x 17")"
"Folio (8.5 x 13")"
"Legal (8.5 x 14")"
"Letter (8.5 x 11")"
"Executive (7.25 x 10.5")"
"Statement (5.5 x 8.5")"
"В6 (128 х 182 мм)"
"А6 (105 х 148 мм)"
"A5 (148 x 210 мм)"
"B5 (182 x 257 мм)"
"A4 (210 x 297 мм)"
"B4 (257 x 364 мм)"
"A3 (297 x 420 мм)"
"A2 (420 x 594 мм)"
"A1 (594 x 841 мм)"

Я пользуюсь только форматами А3 и А4
"A4 (210 x 297 мм)"
"A3 (297 x 420 мм)"

Колька · 12.11.2009, 13:43

короче просто меняй строчку:

Код:

[Выделить все]

(setq l_paper '("A1" "A2" "A3" "A4"))

на:

Код:

[Выделить все]

(setq l_paper '("A1 (594 x 841 мм)" "A2 (420 x 594 мм)" "A3 (297 x 420 мм)" "A4 (210 x 297 мм)"))

и должно быть для твоего принтера всё ок.
а я пока поскриплю мозгами как вытащить список листов

Do$ · 12.11.2009, 13:49

Цитата:

Сообщение от Колька

как вытащить список листов

У меня получилось только для текущего принтера/плоттера:

Код:

[Выделить все]

(mapcar	'(lambda (a) (vla-GetLocaleMediaName lay a))
	(vlax-safearray->list
	  (vlax-variant-value
	    (vla-GetCanonicalMediaNames
	      (setq lay	(vla-get-ActiveLayout
			  (vla-get-ActiveDocument (vlax-get-acad-object))
			) ;_ end of vla-get-ActiveLayout
	      ) ;_ end of setq
	    ) ;_ end of vla-GetCanonicalMediaNames
	  ) ;_ end of vlax-variant-value
	) ;_ end of vlax-safearray->list
) ;_ end of mapcar

Колька · 12.11.2009, 14:03

пасиб

Это не выход, но надеюсь направит в нужную сторону

Do$ · 12.11.2009, 14:08

Насколько я понял, тут без вариантов. Сперва задаешь текущий плоттер, потом можно уже получить список его листов. Получить список листов другим способом нереально. Можно, конечно, сделать перебор: делаешь текущим первый плоттер из списка - считываешь его форматы - сохраняешь данные - делаешь текущим следующий плоттер - ... Но этот процесс очень небыстрый.

Колька · 12.11.2009, 14:10

вот как раз мне это и надо, я сделаю после выбора принтера его текущим и выдам список только для этого принтера

только надеюсь текущий это не тот который в винде по умалчанию, а то это неохото трогать

Do$ · 12.11.2009, 14:21

По умолчанию стоит плоттер с оригинальным названием "None"(анг.версия)

(если настройки печати не менялись в листе)

Колька · 12.11.2009, 14:31

Do$ подскажи плиз глупому какой сиспеременной или командой можно сменить текущий плоттер

Do$ · 12.11.2009, 14:36

Код:

[Выделить все]

(vla-put-ConfigName
  (vla-get-ActiveLayout
    (vla-get-ActiveDocument (vlax-get-acad-object))
  ) ;_ end of vla-get-ActiveLayout
  "тут имя принтера/плоттера"
) ;_ end of vla-put-ConfigName

Цитата:

только надеюсь текущий это не тот который в винде по умалчанию, а то это неохото трогать

Нет, конечно. Меняется только принтер для текущей вкладки.

JokerrSergh · 12.11.2009, 15:03

вот подгрузил людей

Забегу завтра, раб. день подошел к концу

Колька · 12.11.2009, 15:15

Всё супер

коды вставил теперь при выборе бумаги выдаёться большущий правдивый список

я там свою прогу подправил теперь можно пользоваться.
Do$ ты просто гений, я там пока в этих vla- в справке ковырялся чуть голову не сломал

Кстати JokerrSergh что бы точки делать видимыми и не видимыми можешь в код добавить:

Код:

[Выделить все]

(defun C:NPointV (/)
	(if (/= (getvar "pdmode") 35) (setvar "pdmode" 35))
	(if (/= (getvar "pdsize") -1) (setvar "pdsize" -1)))
(defun C:NPointInv (/)
	(if (/= (getvar "pdmode") 0) (setvar "pdmode" 0))
	(if (/= (getvar "pdsize") 0) (setvar "pdsize" 0))
)

Do$ · 12.11.2009, 15:26

Цитата:

Сообщение от Колька

Do$ ты просто гений, я там пока в этих vla- в справке ковырялся чуть голову не сломал

Не гений, просто я уже вторую неделю сижу ковыряю vla на предмет печати, чтобы избавиться от коммандных методов.

Do$ · 13.11.2009, 16:25

Колька, мне вот что интересно: а если твой блок "Ramka_dlya_pechati" стоит в нескольких листах чертежа, как будет происходить печать тех блоков, которые находятся не на текущем листе?

Колька · 13.11.2009, 22:04

Цитата:

Сообщение от Do$

Колька, мне вот что интересно: а если твой блок "Ramka_dlya_pechati" стоит в нескольких листах чертежа, как будет происходить печать тех блоков, которые находятся не на текущем листе?

хреново

я об этом думал, тока пока не было повода дописать. у меня был код выделяющий все блоки с определённым именем на чертеже, можно её приделать сюда, потом, если понадобится.

Получилось хоть у кого нить прогу то запустить?

JokerrSergh · 16.11.2009, 07:09

Колька, получилось запустить, все работает и печатает

Теперь вопросы:
1. После запуска проги нужно каждый раз устанавливать принтер и бумагу? Или можно сделать чтобы при первом запуске проги выбрал принтер, а при остальных запусках он уже был установлен.
2. Хотелось бы иметь возможность менять масштаб печати, ибо "вписать" не всегда устраивает.
В остальном меня все устраивает

СПАСИБО разработчику и всем участникам

Колька · 16.11.2009, 07:35

Всю автоматичность можно задать в строчке (command "_plot"...
например если хочешь что бы был принтер XEROX WORKCENTRE PRO 133 PCL 6 и масштаб 1:100 пишешь так:

Код:

[Выделить все]

(command "_plot" "_y" "" "XEROX WORKCENTRE PRO 133 PCL 6" paper "_Millimeters" text "_No" "_Window" p1 p2  "1:100" "_center" "_Yes" "monochrome.ctb" "_Yes" "_As" "_N" "_N" "_Y")

и не забудь если сделал фиксированный принтер удалить строчки

Код:

[Выделить все]

	(setq l_pr (vlax-safearray->list (vlax-variant-value (vla-GetPlotDeviceNames (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object)))))))  
	(setq printer (dialog_n l_pr))

можешь этот код на разные команды сделать и разные кнопочки присвоить

JokerrSergh · 16.11.2009, 07:48

Благодарствую, все стало именно так, как мне нужно

И еще вопрос:
Я так понял, что за один запуск проги, можно напечатать листы только одного формата.
Можно ли как-нибудь одновременно (при одном запуске проги) печатать несколько форматов листов (например А3 и А4)?
Т.е. запускаешь прогу и выделяешь лист формата А3 и лист формата А4, и прога печатает лист А3 и лист А4.

Было бы здорово чтобы прога умела сама определять нужный формат листа по соотношению сторон этого листа (при условии, что сам лист начерчен правильно: т.е. А4=210х297, или 2100х2970 и т.п.)

JokerrSergh · 18.11.2009, 04:35

и тишина

Колька · 18.11.2009, 08:31

пардон, у меня что то оповещение не дошло.

Цитата:

Сообщение от JokerrSergh

Было бы здорово чтобы прога умела сама определять нужный формат листа по соотношению сторон этого листа (при условии, что сам лист начерчен правильно: т.е. А4=210х297, или 2100х2970 и т.п.)

Я над этим думал, но проблема в том что листы не всегда в одном масштабе рисуют, в следствии чего по размеру лист не опознать, по пропорциям тоже не катит(они все одинаковые) единственное что приходит в голову сделать у моего блока атрибут и по нему проверять, что за лист. Короче надо думать чем жертвовать временем при распечатке или при расстановке блоков.

JokerrSergh · 18.11.2009, 09:15

Цитата:

Сообщение от Колька

пардон, у меня что то оповещение не дошло.

Я над этим думал, но проблема в том что листы не всегда в одном масштабе рисуют, в следствии чего по размеру лист не опознать, по пропорциям тоже не катит(они все одинаковые) единственное что приходит в голову сделать у моего блока атрибут и по нему проверять, что за лист. Короче надо думать чем жертвовать временем при распечатке или при расстановке блоков.

Я бы сделал так (если бы умел программировать):
1)В твой блок с точками запихать атрибут, отражающий масштаб листа. По умолчанию задать масштаб 1, или 1:1 (зависит от формы отображения масштаба). Если какой-нибудь лист нарисован в отличном от 1:1 масштабе, то во время расстановки этих блоков юзер изменяет значение атрибута на нужный масштаб.
2)После ввода в ком. строку NPr прога должна взять Х distance и Y distance из твоего блока с точками и сравнить их значения с некой базой, в которой заложены размеры листов (с учетом масштаба). Результатом сравнения должен быть формат листа, который подается на принтер.

LSN · 18.11.2009, 09:20

Попробывал твою прогу. Все нормально запустилось. Но действительно было бы удобно, если бы она сама распознавала формат листа.

Цитата:

Сообщение от Колька

Короче надо думать чем жертвовать временем при распечатке или при расстановке блоков.

Лучше пожертвовать временем при расстановке блоков, т.к. их все равно нужно расставлять, а изменить атрибут можно сразу нескольким блокам.

Есть ли возможность определять формат по названию параметра видимости динамического блока? И возможно ли тогда будет в блок вставить рамку, или здесь и возникают ошибки о которых ты писал?

Колька · 18.11.2009, 09:36

Мысли хорошие, только мешает одна весч, у всех принтеров по разному называються форматы и что хуже того одни и те же форматы могут быть разные по размерам(оверсайс там и всё такое). Действительно унверсальную прогу можно сделать если только что то подготовительное делать что б адаптировать её для принтера

Скорей всего придёться при самом первом запуске проги говорить ей какой формат с каким соотносится и в текстовый файлик это записать. Буду думать как это сделать.

Do$ · 18.11.2009, 11:00

Как альтернативу, выложу бета-версию программы, в которой я попытался по максимуму уйти от коммандных методов.
Печатает варианты:

выбранный объект
несколько выбранных объектов
все блоки с определенным именем на чертеже

Бета-версия, потому что есть мысли по усовершенствованию (если будет время и желание

)
У программы есть особенности:

изменяются настройки печати для вкладки.
с динамическими блоками и мультитекстом могут быть неполадки
другие, пока не замеченные

Код:

[Выделить все]

(defun c:easyplot (/		     MGetBoundingBox
		   plotter-format-dialog
		   Table	     _dwgru-conv-pickset-to-list
		   ent		     ss
		   str		     adoc
		   box		     lay
		   plot_paper_name   plot
		  )

  (defun MGetBoundingBox (ename			 /
			  GetBoundingBox	 GetBoundingBox_dynblock
			  Spline_getBoundingBox
			 )

    (defun GetBoundingBox (en / obj minpt maxpt)
      (if (= (type en) 'ENAME)
	(progn
	  (setq obj (vlax-ename->vla-object en))
	  (vla-getboundingbox obj 'minpt 'maxpt)
	  (list
	    (vlax-safearray->list minpt)
	    (vlax-safearray->list maxpt)
	  ) ;_ end of list
	) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of defun


    (defun GetBoundingBox_dynblock (ent / lst min_point max_point)
      (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 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
		 min_point (mapcar
			     (function +)
			     (mapcar
			       (function
				 (lambda (f)
				   (apply
				     (function min)
				     (mapcar
				       f
				       (mapcar
					 (function
					   (lambda (x) (cdr (assoc "min" x)))
					 ) ;_ 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
			     (vlax-safearray->list
			       (vlax-variant-value
				 (vla-get-insertionpoint ent)
			       ) ;_ end of vlax-variant-value
			     ) ;_ end of vlax-safearray->list
			   ) ;_ end of mapcar
		 max_point (mapcar
			     (function +)
			     (mapcar
			       (function
				 (lambda (f)
				   (apply
				     (function max)
				     (mapcar
				       f
				       (mapcar
					 (function
					   (lambda (x) (cdr (assoc "max" x)))
					 ) ;_ 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
			     (vlax-safearray->list
			       (vlax-variant-value
				 (vla-get-insertionpoint ent)
			       ) ;_ end of vlax-variant-value
			     ) ;_ end of vlax-safearray->list
			   ) ;_ end of mapcar
		 lst	   (list (cons "min" min_point) (cons "max" max_point))
		 lst	   (list min_point max_point)
	   ) ;_ end of setq
	 ) ;_ end of progn
      ) ;_ end of if
      lst
    ) ;_ end of defun



    (defun Spline_getBoundingBox (obj	      /		  c_pt_lst
				  cd_pt_lst   ex_pt_lst	  cls_pt_lst
				  p_lst	      divid	  spline_extr
				 )


      (defun spline_extr (obj pst / it)
			 ;|
Функция поиска экстремума сплайна на основе метода Ньютона.
Исходные параметры:
 obj - VLA-OBJECT или ENAME вида: #<VLA-OBJECT IAcadSpline 05548644> или <Entity name: 7ef65fb8>
 pst - параметр сплайна в точке начального приближения к экстремуму, действительное число

Возвращаемые значения:
 Список вида: (параметр1 параметр2 параметр3)
 параметр 1(2,3) может быть действительным положительным числом или nil, если экстремум
 не был найден (метод не сошелся).
 Примеры: (137.199 173.728 147.543)
	  (nil nil 219.258)

Пример вызова:
(spline_extr
  (setq	obj
	 (vlax-ename->vla-object
	   (car (entsel "\nВыберите сплайн:"))
	 ) ;_ end of vlax-ename->vla-object
  ) ;_ end of setq
  (vlax-curve-getParamAtPoint
    obj
    (getpoint "\nУкажите точку на сплайне:")
  ) ;_ end of vlax-curve-getParamAtPoint
) ;_ end of spline_extr
|;
	(if pst
	  (mapcar
	    (function
	      (lambda (cadrs / f df p)
		(setq it 0
		      p	 pst
		) ;_ end of setq
		(while (not (or	(equal f 0.0 1.0e-008)
				(equal df 0.0 1.0e-008)
				(> it 10)
			    ) ;_ end of or
		       ) ;_ end of not
		  (setq	it (1+ it)
			f  ((eval cadrs) (vlax-curve-getfirstderiv obj p))
			df ((eval cadrs) (vlax-curve-getsecondderiv obj p))
			p  (if (equal df 0.0 1.0e-008)
			     p
			     (- p (/ f df))
			   ) ;_ end of if
		  ) ;_ end of setq
		) ;_ end of while
		(if (or	(< p (vlax-curve-getStartParam obj))
			(> p (vlax-curve-getEndParam obj))
			(> it 10)
		    ) ;_ end of or
		  nil
		  p
		) ;_ end of if
	      ) ;_ end of lambda
	    ) ;_ end of function
	    (list car cadr caddr)
	  ) ;_ end of mapcar
	) ;_ end of if
      ) ;_ end of defun

      (defun divid (pt1 pt2 n)
		   ;|
    Функция нахождения точек, делящих отрезок
    на заданное количество равных частей.

Исходные параметры:
    pt1 - начало отрезка
    pt2 - конец отрезка
    n - количество частей

Пример вызова:
    (divid '(0.0 0.0 0.0) '(15.0 15.0 15.0) 3)
    (divid '(0.0 0.0) '(12.0 12.0) 4)

Возвращаемое значение - список точек вида:
    ((5.0 5.0 5.0) (10.0 10.0 10.0))
    ((3.0 3.0) (6.0 6.0) (9.0 9.0))
|;
	(mapcar
	  '(lambda (c)
	     (mapcar '(lambda (a b) (+ (* c (/ (- a b) n)) b)) pt2 pt1)
	   ) ;_ end of lambda
	  (
	   (lambda (d / rez)
	     (repeat (setq d (1- d))
	       (setq rez (cons d rez)
		     d	 (1- d)
	       ) ;_ end of setq
	     ) ;_ end of repeat
	     rez
	   ) ;_ end of lambda
	    n
	  )
	) ;_ end of mapcar
      ) ;_ end of defun

      (if (= (type obj) 'ENAME)
	(setq obj (vlax-ename->vla-object obj))
      ) ;_ end of if
      (setq c_pt_lst   (mapcar
			 '(lambda (x)
			    (vlax-safearray->list
			      (vlax-variant-value
				(vla-getcontrolpoint obj x)
			      ) ;_ end of vlax-variant-value
			    ) ;_ end of vlax-safearray->list
			  ) ;_ end of lambda
			 ((lambda (/ n lst)
			    (repeat
			      (1- (setq
				    n (1- (vla-get-NumberOfControlPoints obj))
				  ) ;_ end of setq
			      ) ;_ end of 1-
			       (setq
				 n   (1- n)
				 lst (cons n lst)
			       ) ;_ end of setq
			    ) ;_ end of repeat
			    lst
			  ) ;_ end of lambda
			 )
		       ) ;_ end of mapcar
	    cd_pt_lst  ((lambda	(lst / rez)
			  (while lst
			    (if	(cadr lst)
			      (setq
				rez (append
				      rez
				      (cons (car lst)
					    (divid (car lst) (cadr lst) 3)
				      ) ;_ end of cons
				    ) ;_ end of append
			      ) ;_ end of setq
			      (setq rez (append rez lst))
			    ) ;_ end of if
			    (setq lst (cdr lst))
			  ) ;_ end of while
			  rez
			) ;_ end of lambda
			 c_pt_lst
		       )
	    cls_pt_lst (mapcar
			 '(lambda (pt)
			    (vlax-curve-getclosestpointto obj pt)
			  ) ;_ end of lambda
			 cd_pt_lst
		       ) ;_ end of mapcar
	    p_lst      (vl-remove-if
			 'not
			 (apply
			   'append
			   (mapcar
			     (function (lambda (x)
					 (spline_extr
					   obj
					   (vlax-curve-getParamAtPoint obj x)
					 ) ;_ end of spline_extr
				       ) ;_ end of lambda
			     ) ;_ end of function
			     cls_pt_lst
			   ) ;_ end of mapcar
			 ) ;_ end of apply
		       ) ;_ end of vl-remove-if
	    ex_pt_lst  (append
			 (list
			   (vlax-curve-getStartPoint obj)
			   (vlax-curve-getEndPoint obj)
			 ) ;_ end of list
			 (mapcar
			   (function
			     (lambda (p) (vlax-curve-getPointAtParam obj p))
			   ) ;_ end of function
			   p_lst
			 ) ;_ end of mapcar
		       ) ;_ end of append
      ) ;_ end of setq
      (mapcar
	(function
	  (lambda (mins)
	    (mapcar
	      (function	(lambda	(cadrs)
			  (apply (function mins)
				 (mapcar (function cadrs) ex_pt_lst)
			  ) ;_ 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
    ) ;_ end of defun

    (mapcar
      (function	(lambda	(a)
		  (mapcar (function (lambda (b)
				      (if (equal b 0.0 1.0e-007)
					0.0
					b
				      ) ;_ end of if
				    ) ;_ end of lambda
			  ) ;_ end of function
			  a
		  ) ;_ end of mapcar
		) ;_ end of lambda
      ) ;_ end of function
      (cond
	((and
	   (= (cdr (assoc 0 (entget ename))) "INSERT")
	   (vlax-property-available-p
	     (vlax-ename->vla-object ename)
	     'isdynamicblock
	   ) ;_ end of vlax-property-available-p
	   (equal (vla-get-isdynamicblock (vlax-ename->vla-object ename))
		  :vlax-true
	   ) ;_ end of equal
	 ) ;_ end of and
	 (GetBoundingBox_dynblock ename)
	)
	((= (cdr (assoc 0 (entget ename))) "SPLINE")
	 (Spline_getBoundingBox ename)
	)
	(T (GetBoundingBox ename))
      ) ;_ end of cond
    ) ;_ end of mapcar
  ) ;_ end of defun

  (defun plotter-format-dialog
			       (lay	      /
				easyplot-action-fun
				run_dialog    fo
				fn	      plot_names
				paper_name
			       )

    (defun easyplot-action-fun (key value data reason x y)
      (cond
	((= key "plot_names")
	 (setq plot_name (nth (atoi value) plot_names))
	 (done_dialog 2)
	)
	((= key "accept")
	 (setq paper_name
		(cdr
		  (nth (atoi (get_tile "paper_names")) paper_names)
		) ;_ end of cdr
	 ) ;_ end of setq
	 (done_dialog 1)
	)
	((= key "cancel") (setq paper_name 0) (done_dialog 3))
      ) ;_ end of cond
    ) ;_ end of defun

    (defun run_dialog (file dlg rexp action / dl1)
      (if (and (= (type file) (type dlg) 'STR)
	       (= (type rexp) 'LIST)
	  ) ;_ end of and
	(if (> (setq dl1 (load_dialog file)) 0)
	  (progn
	    (if	(new_dialog dlg dl1 action)
	      (progn
		(if
		  (vl-catch-all-error-p (vl-catch-all-apply rexp))
		   (progn
		     (princ "\nОшибка в выражении!")
		     (term_dialog)
		     (unload_dialog dl1)
		   ) ;_ end of progn
		   (progn
		     (start_dialog)
		     (unload_dialog dl1)
		   ) ;_ end of progn
		) ;_ end of if
	      ) ;_ end of progn
	      (alert
		(strcat
		  "В файле: \""		     file
		  "\"\nне найдено описания диалога:\n\""
		  dlg			     "\""
		 ) ;_ end of strcat
	      ) ;_ end of alert
	    ) ;_ end of if
	  ) ;_ end of progn
	  (alert (strcat "Файл: \"" file "\" не найден!"))
	) ;_ end of if
      ) ;_ end of if
    ) ;_ end of defun

    (setq
      plot_names (vl-sort
		   (vl-remove-if
		     '(lambda (a)
			(or (= (strcase a T) "none")
			    (wcmatch a "*.pc3")
			) ;_ end of or
		      ) ;_ end of lambda
		     (vlax-safearray->list
		       (vlax-variant-value (vla-GetPlotDeviceNames lay))
		     ) ;_ end of vlax-safearray->list
		   ) ;_ end of vl-remove-if
		   '<
		 ) ;_ end of vl-sort
      plot_name	 (car plot_names)
      fn	 (vl-filename-mktemp "objpr" nil ".dcl")
      fo	 (open fn "w")
    ) ;_ end of setq
    (write-line
      (strcat
	"print_device:dialog{label=\"Выбор устройства печати       \";"
	":column {:text{label=\"Выберите принтер или плоттер:\";}:popup_list{key=\"plot_names\";}"
	":text{label=\"Выберите формат/размер листа:\";}:popup_list{key=\"paper_names\";}}ok_cancel;}"
      ) ;_ end of strcat
      fo
    ) ;_ end of write-line
    (close fo)
    (while (not paper_name)
      (run_dialog
	fn
	"print_device"
	(function
	  (lambda ()
	    (start_list "plot_names")
	    (mapcar 'add_list
		    plot_names
	    ) ;_ end of mapcar
	    (end_list)
	    (set_tile "plot_names"
		      (itoa (vl-position plot_name plot_names))
	    ) ;_ end of set_tile
	    (vla-put-ConfigName lay plot_name)
	    (setq paper_names
		   (vl-sort
		     (vl-remove-if
		       '(lambda	(y)
			  (wcmatch (car y) "*Inches*,*Pixels*,~*A#*")
			) ;_ end of lambda
		       (mapcar
			 '(lambda (c)
			    (cons (vla-GetLocaleMediaName lay c) c)
			  ) ;_ end of lambda
			 (vlax-safearray->list
			   (vlax-variant-value
			     (vla-GetCanonicalMediaNames lay)
			   ) ;_ end of vlax-variant-value
			 ) ;_ end of vlax-safearray->list
		       ) ;_ end of mapcar
		     ) ;_ end of vl-remove-if
		     '(lambda (a b) (< (car a) (car b)))
		   ) ;_ end of vl-sort
	    ) ;_ end of setq
	    (start_list "paper_names")
	    (mapcar '(lambda (a) (add_list (car a)))
		    paper_names
	    ) ;_ end of mapcar
	    (end_list)
	  ) ;_ end of lambda
	) ;_ end of function
	"(easyplot-action-fun  $key $value $data $reason $x $y)"
      ) ;_ end of run_dialog
    ) ;_ end of while
    (vl-file-delete (findfile fn))
    (if	(and (= (type paper_name) 'STR) (/= (strlen paper_name) 0))
      (progn
	(vla-put-CanonicalMediaName lay paper_name)
	(list plot_name paper_name)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun



  (defun Table (s / d r)
	       ;|
Взято с dwg.ru
written by Michael Puckett.
Вызов
(table "style")
(table "layer")
|;
    (while (setq d (tblnext s (null d)))
      (setq r (append r (list (cdr (assoc 2 d)))))
    ) ;_ end of while
  ) ;_ end of defun

  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
		  item (sslength value)
	    ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
    ) ;_ end repeat
  ) ;_ end defun

  (vl-load-com)
  (setq	adoc (vla-get-ActiveDocument (vlax-get-acad-object))
	lay  (vla-get-ActiveLayout adoc)
	plot (vla-get-plot adoc)
  ) ;_ end of setq
  (if (ssget "_X" (list (cons 410 (getvar "ctab"))))
    (progn
      (while (not ent)
	(setq ent
	       (vl-catch-all-apply
		 (function
		   (lambda ()
		     (initget "Несколько Блок _Multy Block")
		     (entsel
		       "\nУкажите объект для печати, или:[Несколько/ Блок]"
		     ) ;_ end of getkword
		   ) ;_ end of lambda
		 ) ;_ end of function
	       ) ;_ end of vl-catch-all-apply
	) ;_ end of setq
	(cond
	  ((not ent) (princ "\nНичего не указано!"))
	  ((vl-catch-all-error-p ent) (setq ent "exit"))
	  ((and (listp ent) (= (type (car ent)) 'ENAME))
	   (setq ent (list (car ent)))
	  )
	  (;|(and (= (type ent) 'STR)|;
	   (= ent "Multy")		;)
	   (setq
	     ss	(vl-catch-all-apply
		  (function (lambda ()
			      (princ "\nВыберите объекты для печати:")
			      (ssget)
			    ) ;_ end of lambda
		  ) ;_ end of function
		) ;_ end of vl-catch-all-apply
	   ) ;_ end of setq
	   (cond
	     ((not ss) (princ "\nНичего не выбрано!"))
	     ((vl-catch-all-error-p ss) (setq ent "exit"))
	     (T
	      (setq ent (_dwgru-conv-pickset-to-list ss))
	     )
	   ) ;_ end of cond
	  )
	  ((and (= (type ent) 'STR) (= ent "Block"))
	   (if
	     (ssget "_X"
		    (list (cons 0 "INSERT") (cons 410 (getvar "ctab")))
	     ) ;_ end of ssget
	      (progn
		(setq ent nil)
		(while (or (not ent) (= ent "Name"))
		  (if (/= ent "Name")
		    (setq ent
			   (vl-catch-all-apply
			     (function
			       (lambda ()
				 (initget "Имя _Name")
				 (entsel "\nУкажите блок для образца, или:[Имя]"
				 ) ;_ end of entsel
			       ) ;_ end of lambda
			     ) ;_ end of function
			   ) ;_ end of vl-catch-all-apply
		    ) ;_ end of setq
		  ) ;_ end of if
		  (cond
		    ((not ent) (princ "\nНичего не выбрано!"))
		    ((vl-catch-all-error-p ent) (setq ent "exit"))
		    ((and (listp ent)
			  (= (type (car ent)) 'ENAME)
			  (= (cdr (assoc 0 (entget (car ent)))) "INSERT")
		     ) ;_ end of and
		     (setq
		       ent
			(vl-remove-if
			  (function
			    (lambda (a)
			      (/= (vla-get-EffectiveName
				    (vlax-ename->vla-object a)
				  ) ;_ end of vla-get-EffectiveName
				  (vla-get-EffectiveName
				    (vlax-ename->vla-object (car ent))
				  ) ;_ end of vla-get-EffectiveName
			      ) ;_ end of /=
			    ) ;_ end of lambda
			  ) ;_ end of function
			  (_dwgru-conv-pickset-to-list
			    (ssget "_X"
				   (list (cons 0 "INSERT")
					 (assoc 410 (entget (car ent)))
				   ) ;_ end of list
			    ) ;_ end of ssget
			  ) ;_ end of _dwgru-conv-pickset-to-list
			) ;_ end of vl-remove-if
		     ) ;_ end of setq
		    )
		    ((and (listp ent)
			  (= (type (car ent)) 'ENAME)
			  (/= (cdr (assoc 0 (entget (car ent)))) "INSERT")
		     ) ;_ end of and
		     (princ "\nВыбранное не является блоком!")
		    )
		    ((= ent "Name")
		     (setq str
			    (vl-catch-all-apply
			      (function
				(lambda	()
				  (initget "?")
				  (getstring T "\nВведите имя блока, или:[?]")
				) ;_ end of lambda
			      ) ;_ end of function
			    ) ;_ end of vl-catch-all-apply
		     ) ;_ end of setq
		     (cond
		       ((vl-catch-all-error-p str) (setq ent "exit"))
		       ((= str "?")
			(princ "\nЧертеж содержит следующие блоки:")
			(foreach a (vl-sort (Table "Block") '<)
			  (princ (strcat "\n\"" a "\""))
			) ;_ end of foreach
			(TextPage)
		       )
		       ((and (tblsearch "Block" str)
			     (setq
			       ss (ssget "_X"
					 (list (cons 0 "INSERT")
					       (cons 2 str)
					       (cons 410 (getvar "ctab"))
					 ) ;_ end of list
				  ) ;_ end of ssget
			     ) ;_ end of setq
			) ;_ end of and
			(setq
			  ent
			   (_dwgru-conv-pickset-to-list
			     ss
			   ) ;_ end of _dwgru-conv-pickset-to-list
			) ;_ end of setq
		       )
		       (T
			(princ
			  "\nБлока с таким именем в текущей вкладке нет!"
			) ;_ end of princ
		       )
		     ) ;_ end of cond
		    )
		  ) ;_ end of cond
		) ;_ end of while
	      ) ;_ end of progn
	      (progn
		(setq ent nil)
		(princ "\nТекущая вкладка не содержит блоков!")
	      ) ;_ end of progn
	   ) ;_ end of if
	  ) ;_ end of cond
	) ;_ end of cond
      ) ;_ end of while
      (if
	(and
	  (not (and (= (type ent) 'STR) (= ent "exit")))
	  (setq plot_paper_name (plotter-format-dialog lay))
	) ;_ end of and
	 (progn
	   (mapcar '(lambda (a) (vlax-put-property lay (car a) (cdr a)))
		   (list
		     (cons "PlotType" acDisplay)
		     (cons "CenterPlot" :vlax-true)
		     (cons "PaperUnits" acMillimeters)
		     (cons "PlotHidden" :vlax-false)
		     (cons "PlotViewportBorders" :vlax-false)
		     (cons "PlotViewportsFirst" :vlax-false)
		     (cons "PlotWithLineweights" :vlax-true)
		     (cons "UseStandardScale" :vlax-true)
		     (cons "StandardScale" acVpScaleToFit)
		   ) ;_ end of list
	   ) ;_ end of mapcar
	   (if (member "monochrome.ctb"
		       (vl-sort
			 (vl-remove-if
			   (function (lambda (a) (wcmatch a "*.stb")))
			   (vlax-safearray->list
			     (vlax-variant-value
			       (vla-GetPlotStyleTableNames lay)
			     ) ;_ end of vlax-variant-value
			   ) ;_ end of vlax-safearray->list
			 ) ;_ end of vl-remove-if
			 (function <)
		       ) ;_ end of vl-sort
	       ) ;_ end of member
	     (progn
	       (vla-put-PlotWithPlotStyles lay :vlax-true) ;_ :vlax-false or :vlax-true
	       (vla-put-StyleSheet lay "monochrome.ctb")
	     ) ;_ end of progn
	     (progn
	       (vla-put-PlotWithPlotStyles lay :vlax-false)
	     ) ;_ end of progn
	   ) ;_ end of if
	   (vla-put-NumberOfCopies plot 1)
	   (foreach
		     b
		      ent
	     (setq box (MGetBoundingBox b))
	     (vla-SetWindowToPlot
	       lay
	       (vlax-safearray-fill
		 (vlax-make-safearray
		   vlax-vbDouble
		   '(0 . 1)
		 ) ;_ end of vlax-make-safearray
		 ((lambda (x) (list (car x) (cadr x)))
		   (car box)
		 )
	       ) ;_ end of vlax-safearray-fill
	       (vlax-safearray-fill
		 (vlax-make-safearray
		   vlax-vbDouble
		   '(0 . 1)
		 ) ;_ end of vlax-make-safearray
		 ((lambda (x) (list (car x) (cadr x)))
		   (cadr box)
		 )
	       ) ;_ end of vlax-safearray-fill
	     ) ;_ end of vla-SetWindowToPlot
	     (vla-put-PlotType lay acWindow)
	     (vla-put-PlotRotation
	       lay
	       (if
		 (apply
		   (function >)
		   (cdr
		     (reverse (mapcar (function -) (cadr box) (car box)))
		   ) ;_ end of cdr
		 ) ;_ end of apply
		  ac0degrees
		  ac90degrees
	       ) ;_ end of if
	     ) ;_ end of vla-put-PlotRotation
	     (
	      (lambda (lst / var_lst cur_val_lst temp_val_lst)
		(setq var_lst	   (mapcar (function car) lst)
		      temp_val_lst (mapcar (function cdr) lst)
		      cur_val_lst  (mapcar (function getvar) var_lst)
		) ;_ end of setq
		(mapcar (function setvar) var_lst temp_val_lst)
		(vl-cmdf "_.plot" "_no" "" "" "" "_no" "_no" "_yes")
		(mapcar (function setvar) var_lst cur_val_lst)
	      ) ;_ end of lambda
	       (list (cons "cmdecho" 0))
	     )
	   ) ;_ end of foreach
	 ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of progn
    (princ
      "\nРабота программы невозможна - текущая вкладка не содержит объектов!"
    ) ;_ end of princ
  ) ;_ end of if
  (princ)
) ;_ end of defun

Колька · 18.11.2009, 11:37

Do$, професионально

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

Do$ · 18.11.2009, 11:57

Цитата:

Сообщение от Колька

я и не подумал о том что можно .dcl автоматически создавать

Тоже об этом не помышлял, пока не заметил в pltools у VVA

Кулик Алексей aka kpblc · 18.11.2009, 13:28

Цитата:

Сообщение от JokerrSergh

и тишина

http://forum.dwg.ru/showthread.php?t=30619

zenon · Регистрация: 21.02.2005

Поскольку предыдущая тема Печать из модели по выбору объекта, по вине несознательных товарищей была закрыта, а суть вопроса до конца не раскрыта, создаю новую тему.
Итак, с темой вопроса прошу ознакомится в приведенной выше ссылке, сегодня имеем программку товарища Do$

Цитата:

Код:

[Выделить все]

(defun c:easyplot (/		     MGetBoundingBox
		   plotter-format-dialog
		   Table	     _dwgru-conv-pickset-to-list
		   ent		     ss
		   str		     adoc
		   box		     lay
		   plot_paper_name   plot
		  )

  (defun MGetBoundingBox (ename			 /
			  GetBoundingBox	 GetBoundingBox_dynblock
			  Spline_getBoundingBox
			 )

    (defun GetBoundingBox (en / obj minpt maxpt)
      (if (= (type en) 'ENAME)
	(progn
	  (setq obj (vlax-ename->vla-object en))
	  (vla-getboundingbox obj 'minpt 'maxpt)
	  (list
	    (vlax-safearray->list minpt)
	    (vlax-safearray->list maxpt)
	  ) ;_ end of list
	) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of defun


    (defun GetBoundingBox_dynblock (ent / lst min_point max_point)
      (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 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
		 min_point (mapcar
			     (function +)
			     (mapcar
			       (function
				 (lambda (f)
				   (apply
				     (function min)
				     (mapcar
				       f
				       (mapcar
					 (function
					   (lambda (x) (cdr (assoc "min" x)))
					 ) ;_ 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
			     (vlax-safearray->list
			       (vlax-variant-value
				 (vla-get-insertionpoint ent)
			       ) ;_ end of vlax-variant-value
			     ) ;_ end of vlax-safearray->list
			   ) ;_ end of mapcar
		 max_point (mapcar
			     (function +)
			     (mapcar
			       (function
				 (lambda (f)
				   (apply
				     (function max)
				     (mapcar
				       f
				       (mapcar
					 (function
					   (lambda (x) (cdr (assoc "max" x)))
					 ) ;_ 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
			     (vlax-safearray->list
			       (vlax-variant-value
				 (vla-get-insertionpoint ent)
			       ) ;_ end of vlax-variant-value
			     ) ;_ end of vlax-safearray->list
			   ) ;_ end of mapcar
		 lst	   (list (cons "min" min_point) (cons "max" max_point))
		 lst	   (list min_point max_point)
	   ) ;_ end of setq
	 ) ;_ end of progn
      ) ;_ end of if
      lst
    ) ;_ end of defun



    (defun Spline_getBoundingBox (obj	      /		  c_pt_lst
				  cd_pt_lst   ex_pt_lst	  cls_pt_lst
				  p_lst	      divid	  spline_extr
				 )


      (defun spline_extr (obj pst / it)
			 ;|
Функция поиска экстремума сплайна на основе метода Ньютона.
Исходные параметры:
 obj - VLA-OBJECT или ENAME вида: #<VLA-OBJECT IAcadSpline 05548644> или <Entity name: 7ef65fb8>
 pst - параметр сплайна в точке начального приближения к экстремуму, действительное число

Возвращаемые значения:
 Список вида: (параметр1 параметр2 параметр3)
 параметр 1(2,3) может быть действительным положительным числом или nil, если экстремум
 не был найден (метод не сошелся).
 Примеры: (137.199 173.728 147.543)
	  (nil nil 219.258)

Пример вызова:
(spline_extr
  (setq	obj
	 (vlax-ename->vla-object
	   (car (entsel "\nВыберите сплайн:"))
	 ) ;_ end of vlax-ename->vla-object
  ) ;_ end of setq
  (vlax-curve-getParamAtPoint
    obj
    (getpoint "\nУкажите точку на сплайне:")
  ) ;_ end of vlax-curve-getParamAtPoint
) ;_ end of spline_extr
|;
	(if pst
	  (mapcar
	    (function
	      (lambda (cadrs / f df p)
		(setq it 0
		      p	 pst
		) ;_ end of setq
		(while (not (or	(equal f 0.0 1.0e-008)
				(equal df 0.0 1.0e-008)
				(> it 10)
			    ) ;_ end of or
		       ) ;_ end of not
		  (setq	it (1+ it)
			f  ((eval cadrs) (vlax-curve-getfirstderiv obj p))
			df ((eval cadrs) (vlax-curve-getsecondderiv obj p))
			p  (if (equal df 0.0 1.0e-008)
			     p
			     (- p (/ f df))
			   ) ;_ end of if
		  ) ;_ end of setq
		) ;_ end of while
		(if (or	(< p (vlax-curve-getStartParam obj))
			(> p (vlax-curve-getEndParam obj))
			(> it 10)
		    ) ;_ end of or
		  nil
		  p
		) ;_ end of if
	      ) ;_ end of lambda
	    ) ;_ end of function
	    (list car cadr caddr)
	  ) ;_ end of mapcar
	) ;_ end of if
      ) ;_ end of defun

      (defun divid (pt1 pt2 n)
		   ;|
    Функция нахождения точек, делящих отрезок
    на заданное количество равных частей.

Исходные параметры:
    pt1 - начало отрезка
    pt2 - конец отрезка
    n - количество частей

Пример вызова:
    (divid '(0.0 0.0 0.0) '(15.0 15.0 15.0) 3)
    (divid '(0.0 0.0) '(12.0 12.0) 4)

Возвращаемое значение - список точек вида:
    ((5.0 5.0 5.0) (10.0 10.0 10.0))
    ((3.0 3.0) (6.0 6.0) (9.0 9.0))
|;
	(mapcar
	  '(lambda (c)
	     (mapcar '(lambda (a b) (+ (* c (/ (- a b) n)) b)) pt2 pt1)
	   ) ;_ end of lambda
	  (
	   (lambda (d / rez)
	     (repeat (setq d (1- d))
	       (setq rez (cons d rez)
		     d	 (1- d)
	       ) ;_ end of setq
	     ) ;_ end of repeat
	     rez
	   ) ;_ end of lambda
	    n
	  )
	) ;_ end of mapcar
      ) ;_ end of defun

      (if (= (type obj) 'ENAME)
	(setq obj (vlax-ename->vla-object obj))
      ) ;_ end of if
      (setq c_pt_lst   (mapcar
			 '(lambda (x)
			    (vlax-safearray->list
			      (vlax-variant-value
				(vla-getcontrolpoint obj x)
			      ) ;_ end of vlax-variant-value
			    ) ;_ end of vlax-safearray->list
			  ) ;_ end of lambda
			 ((lambda (/ n lst)
			    (repeat
			      (1- (setq
				    n (1- (vla-get-NumberOfControlPoints obj))
				  ) ;_ end of setq
			      ) ;_ end of 1-
			       (setq
				 n   (1- n)
				 lst (cons n lst)
			       ) ;_ end of setq
			    ) ;_ end of repeat
			    lst
			  ) ;_ end of lambda
			 )
		       ) ;_ end of mapcar
	    cd_pt_lst  ((lambda	(lst / rez)
			  (while lst
			    (if	(cadr lst)
			      (setq
				rez (append
				      rez
				      (cons (car lst)
					    (divid (car lst) (cadr lst) 3)
				      ) ;_ end of cons
				    ) ;_ end of append
			      ) ;_ end of setq
			      (setq rez (append rez lst))
			    ) ;_ end of if
			    (setq lst (cdr lst))
			  ) ;_ end of while
			  rez
			) ;_ end of lambda
			 c_pt_lst
		       )
	    cls_pt_lst (mapcar
			 '(lambda (pt)
			    (vlax-curve-getclosestpointto obj pt)
			  ) ;_ end of lambda
			 cd_pt_lst
		       ) ;_ end of mapcar
	    p_lst      (vl-remove-if
			 'not
			 (apply
			   'append
			   (mapcar
			     (function (lambda (x)
					 (spline_extr
					   obj
					   (vlax-curve-getParamAtPoint obj x)
					 ) ;_ end of spline_extr
				       ) ;_ end of lambda
			     ) ;_ end of function
			     cls_pt_lst
			   ) ;_ end of mapcar
			 ) ;_ end of apply
		       ) ;_ end of vl-remove-if
	    ex_pt_lst  (append
			 (list
			   (vlax-curve-getStartPoint obj)
			   (vlax-curve-getEndPoint obj)
			 ) ;_ end of list
			 (mapcar
			   (function
			     (lambda (p) (vlax-curve-getPointAtParam obj p))
			   ) ;_ end of function
			   p_lst
			 ) ;_ end of mapcar
		       ) ;_ end of append
      ) ;_ end of setq
      (mapcar
	(function
	  (lambda (mins)
	    (mapcar
	      (function	(lambda	(cadrs)
			  (apply (function mins)
				 (mapcar (function cadrs) ex_pt_lst)
			  ) ;_ 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
    ) ;_ end of defun

    (mapcar
      (function	(lambda	(a)
		  (mapcar (function (lambda (b)
				      (if (equal b 0.0 1.0e-007)
					0.0
					b
				      ) ;_ end of if
				    ) ;_ end of lambda
			  ) ;_ end of function
			  a
		  ) ;_ end of mapcar
		) ;_ end of lambda
      ) ;_ end of function
      (cond
	((and
	   (= (cdr (assoc 0 (entget ename))) "INSERT")
	   (vlax-property-available-p
	     (vlax-ename->vla-object ename)
	     'isdynamicblock
	   ) ;_ end of vlax-property-available-p
	   (equal (vla-get-isdynamicblock (vlax-ename->vla-object ename))
		  :vlax-true
	   ) ;_ end of equal
	 ) ;_ end of and
	 (GetBoundingBox_dynblock ename)
	)
	((= (cdr (assoc 0 (entget ename))) "SPLINE")
	 (Spline_getBoundingBox ename)
	)
	(T (GetBoundingBox ename))
      ) ;_ end of cond
    ) ;_ end of mapcar
  ) ;_ end of defun

  (defun plotter-format-dialog
			       (lay	      /
				easyplot-action-fun
				run_dialog    fo
				fn	      plot_names
				paper_name
			       )

    (defun easyplot-action-fun (key value data reason x y)
      (cond
	((= key "plot_names")
	 (setq plot_name (nth (atoi value) plot_names))
	 (done_dialog 2)
	)
	((= key "accept")
	 (setq paper_name
		(cdr
		  (nth (atoi (get_tile "paper_names")) paper_names)
		) ;_ end of cdr
	 ) ;_ end of setq
	 (done_dialog 1)
	)
	((= key "cancel") (setq paper_name 0) (done_dialog 3))
      ) ;_ end of cond
    ) ;_ end of defun

    (defun run_dialog (file dlg rexp action / dl1)
      (if (and (= (type file) (type dlg) 'STR)
	       (= (type rexp) 'LIST)
	  ) ;_ end of and
	(if (> (setq dl1 (load_dialog file)) 0)
	  (progn
	    (if	(new_dialog dlg dl1 action)
	      (progn
		(if
		  (vl-catch-all-error-p (vl-catch-all-apply rexp))
		   (progn
		     (princ "\nОшибка в выражении!")
		     (term_dialog)
		     (unload_dialog dl1)
		   ) ;_ end of progn
		   (progn
		     (start_dialog)
		     (unload_dialog dl1)
		   ) ;_ end of progn
		) ;_ end of if
	      ) ;_ end of progn
	      (alert
		(strcat
		  "В файле: \""		     file
		  "\"\nне найдено описания диалога:\n\""
		  dlg			     "\""
		 ) ;_ end of strcat
	      ) ;_ end of alert
	    ) ;_ end of if
	  ) ;_ end of progn
	  (alert (strcat "Файл: \"" file "\" не найден!"))
	) ;_ end of if
      ) ;_ end of if
    ) ;_ end of defun

    (setq
      plot_names (vl-sort
		   (vl-remove-if
		     '(lambda (a)
			(or (= (strcase a T) "none")
			    (wcmatch a "*.pc3")
			) ;_ end of or
		      ) ;_ end of lambda
		     (vlax-safearray->list
		       (vlax-variant-value (vla-GetPlotDeviceNames lay))
		     ) ;_ end of vlax-safearray->list
		   ) ;_ end of vl-remove-if
		   '<
		 ) ;_ end of vl-sort
      plot_name	 (car plot_names)
      fn	 (vl-filename-mktemp "objpr" nil ".dcl")
      fo	 (open fn "w")
    ) ;_ end of setq
    (write-line
      (strcat
	"print_device:dialog{label=\"Выбор устройства печати       \";"
	":column {:text{label=\"Выберите принтер или плоттер:\";}:popup_list{key=\"plot_names\";}"
	":text{label=\"Выберите формат/размер листа:\";}:popup_list{key=\"paper_names\";}}ok_cancel;}"
      ) ;_ end of strcat
      fo
    ) ;_ end of write-line
    (close fo)
    (while (not paper_name)
      (run_dialog
	fn
	"print_device"
	(function
	  (lambda ()
	    (start_list "plot_names")
	    (mapcar 'add_list
		    plot_names
	    ) ;_ end of mapcar
	    (end_list)
	    (set_tile "plot_names"
		      (itoa (vl-position plot_name plot_names))
	    ) ;_ end of set_tile
	    (vla-put-ConfigName lay plot_name)
	    (setq paper_names
		   (vl-sort
		     (vl-remove-if
		       '(lambda	(y)
			  (wcmatch (car y) "*Inches*,*Pixels*,~*A#*")
			) ;_ end of lambda
		       (mapcar
			 '(lambda (c)
			    (cons (vla-GetLocaleMediaName lay c) c)
			  ) ;_ end of lambda
			 (vlax-safearray->list
			   (vlax-variant-value
			     (vla-GetCanonicalMediaNames lay)
			   ) ;_ end of vlax-variant-value
			 ) ;_ end of vlax-safearray->list
		       ) ;_ end of mapcar
		     ) ;_ end of vl-remove-if
		     '(lambda (a b) (< (car a) (car b)))
		   ) ;_ end of vl-sort
	    ) ;_ end of setq
	    (start_list "paper_names")
	    (mapcar '(lambda (a) (add_list (car a)))
		    paper_names
	    ) ;_ end of mapcar
	    (end_list)
	  ) ;_ end of lambda
	) ;_ end of function
	"(easyplot-action-fun  $key $value $data $reason $x $y)"
      ) ;_ end of run_dialog
    ) ;_ end of while
    (vl-file-delete (findfile fn))
    (if	(and (= (type paper_name) 'STR) (/= (strlen paper_name) 0))
      (progn
	(vla-put-CanonicalMediaName lay paper_name)
	(list plot_name paper_name)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun



  (defun Table (s / d r)
	       ;|
Взято с dwg.ru
written by Michael Puckett.
Вызов
(table "style")
(table "layer")
|;
    (while (setq d (tblnext s (null d)))
      (setq r (append r (list (cdr (assoc 2 d)))))
    ) ;_ end of while
  ) ;_ end of defun

  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
		  item (sslength value)
	    ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
    ) ;_ end repeat
  ) ;_ end defun

  (vl-load-com)
  (setq	adoc (vla-get-ActiveDocument (vlax-get-acad-object))
	lay  (vla-get-ActiveLayout adoc)
	plot (vla-get-plot adoc)
  ) ;_ end of setq
  (if (ssget "_X" (list (cons 410 (getvar "ctab"))))
    (progn
      (while (not ent)
	(setq ent
	       (vl-catch-all-apply
		 (function
		   (lambda ()
		     (initget "Несколько Блок _Multy Block")
		     (entsel
		       "\nУкажите объект для печати, или:[Несколько/ Блок]"
		     ) ;_ end of getkword
		   ) ;_ end of lambda
		 ) ;_ end of function
	       ) ;_ end of vl-catch-all-apply
	) ;_ end of setq
	(cond
	  ((not ent) (princ "\nНичего не указано!"))
	  ((vl-catch-all-error-p ent) (setq ent "exit"))
	  ((and (listp ent) (= (type (car ent)) 'ENAME))
	   (setq ent (list (car ent)))
	  )
	  (;|(and (= (type ent) 'STR)|;
	   (= ent "Multy")		;)
	   (setq
	     ss	(vl-catch-all-apply
		  (function (lambda ()
			      (princ "\nВыберите объекты для печати:")
			      (ssget)
			    ) ;_ end of lambda
		  ) ;_ end of function
		) ;_ end of vl-catch-all-apply
	   ) ;_ end of setq
	   (cond
	     ((not ss) (princ "\nНичего не выбрано!"))
	     ((vl-catch-all-error-p ss) (setq ent "exit"))
	     (T
	      (setq ent (_dwgru-conv-pickset-to-list ss))
	     )
	   ) ;_ end of cond
	  )
	  ((and (= (type ent) 'STR) (= ent "Block"))
	   (if
	     (ssget "_X"
		    (list (cons 0 "INSERT") (cons 410 (getvar "ctab")))
	     ) ;_ end of ssget
	      (progn
		(setq ent nil)
		(while (or (not ent) (= ent "Name"))
		  (if (/= ent "Name")
		    (setq ent
			   (vl-catch-all-apply
			     (function
			       (lambda ()
				 (initget "Имя _Name")
				 (entsel "\nУкажите блок для образца, или:[Имя]"
				 ) ;_ end of entsel
			       ) ;_ end of lambda
			     ) ;_ end of function
			   ) ;_ end of vl-catch-all-apply
		    ) ;_ end of setq
		  ) ;_ end of if
		  (cond
		    ((not ent) (princ "\nНичего не выбрано!"))
		    ((vl-catch-all-error-p ent) (setq ent "exit"))
		    ((and (listp ent)
			  (= (type (car ent)) 'ENAME)
			  (= (cdr (assoc 0 (entget (car ent)))) "INSERT")
		     ) ;_ end of and
		     (setq
		       ent
			(vl-remove-if
			  (function
			    (lambda (a)
			      (/= (vla-get-EffectiveName
				    (vlax-ename->vla-object a)
				  ) ;_ end of vla-get-EffectiveName
				  (vla-get-EffectiveName
				    (vlax-ename->vla-object (car ent))
				  ) ;_ end of vla-get-EffectiveName
			      ) ;_ end of /=
			    ) ;_ end of lambda
			  ) ;_ end of function
			  (_dwgru-conv-pickset-to-list
			    (ssget "_X"
				   (list (cons 0 "INSERT")
					 (assoc 410 (entget (car ent)))
				   ) ;_ end of list
			    ) ;_ end of ssget
			  ) ;_ end of _dwgru-conv-pickset-to-list
			) ;_ end of vl-remove-if
		     ) ;_ end of setq
		    )
		    ((and (listp ent)
			  (= (type (car ent)) 'ENAME)
			  (/= (cdr (assoc 0 (entget (car ent)))) "INSERT")
		     ) ;_ end of and
		     (princ "\nВыбранное не является блоком!")
		    )
		    ((= ent "Name")
		     (setq str
			    (vl-catch-all-apply
			      (function
				(lambda	()
				  (initget "?")
				  (getstring T "\nВведите имя блока, или:[?]")
				) ;_ end of lambda
			      ) ;_ end of function
			    ) ;_ end of vl-catch-all-apply
		     ) ;_ end of setq
		     (cond
		       ((vl-catch-all-error-p str) (setq ent "exit"))
		       ((= str "?")
			(princ "\nЧертеж содержит следующие блоки:")
			(foreach a (vl-sort (Table "Block") '<)
			  (princ (strcat "\n\"" a "\""))
			) ;_ end of foreach
			(TextPage)
		       )
		       ((and (tblsearch "Block" str)
			     (setq
			       ss (ssget "_X"
					 (list (cons 0 "INSERT")
					       (cons 2 str)
					       (cons 410 (getvar "ctab"))
					 ) ;_ end of list
				  ) ;_ end of ssget
			     ) ;_ end of setq
			) ;_ end of and
			(setq
			  ent
			   (_dwgru-conv-pickset-to-list
			     ss
			   ) ;_ end of _dwgru-conv-pickset-to-list
			) ;_ end of setq
		       )
		       (T
			(princ
			  "\nБлока с таким именем в текущей вкладке нет!"
			) ;_ end of princ
		       )
		     ) ;_ end of cond
		    )
		  ) ;_ end of cond
		) ;_ end of while
	      ) ;_ end of progn
	      (progn
		(setq ent nil)
		(princ "\nТекущая вкладка не содержит блоков!")
	      ) ;_ end of progn
	   ) ;_ end of if
	  ) ;_ end of cond
	) ;_ end of cond
      ) ;_ end of while
      (if
	(and
	  (not (and (= (type ent) 'STR) (= ent "exit")))
	  (setq plot_paper_name (plotter-format-dialog lay))
	) ;_ end of and
	 (progn
	   (mapcar '(lambda (a) (vlax-put-property lay (car a) (cdr a)))
		   (list
		     (cons "PlotType" acDisplay)
		     (cons "CenterPlot" :vlax-true)
		     (cons "PaperUnits" acMillimeters)
		     (cons "PlotHidden" :vlax-false)
		     (cons "PlotViewportBorders" :vlax-false)
		     (cons "PlotViewportsFirst" :vlax-false)
		     (cons "PlotWithLineweights" :vlax-true)
		     (cons "UseStandardScale" :vlax-true)
		     (cons "StandardScale" acVpScaleToFit)
		   ) ;_ end of list
	   ) ;_ end of mapcar
	   (if (member "monochrome.ctb"
		       (vl-sort
			 (vl-remove-if
			   (function (lambda (a) (wcmatch a "*.stb")))
			   (vlax-safearray->list
			     (vlax-variant-value
			       (vla-GetPlotStyleTableNames lay)
			     ) ;_ end of vlax-variant-value
			   ) ;_ end of vlax-safearray->list
			 ) ;_ end of vl-remove-if
			 (function <)
		       ) ;_ end of vl-sort
	       ) ;_ end of member
	     (progn
	       (vla-put-PlotWithPlotStyles lay :vlax-true) ;_ :vlax-false or :vlax-true
	       (vla-put-StyleSheet lay "monochrome.ctb")
	     ) ;_ end of progn
	     (progn
	       (vla-put-PlotWithPlotStyles lay :vlax-false)
	     ) ;_ end of progn
	   ) ;_ end of if
	   (vla-put-NumberOfCopies plot 1)
	   (foreach
		     b
		      ent
	     (setq box (MGetBoundingBox b))
	     (vla-SetWindowToPlot
	       lay
	       (vlax-safearray-fill
		 (vlax-make-safearray
		   vlax-vbDouble
		   '(0 . 1)
		 ) ;_ end of vlax-make-safearray
		 ((lambda (x) (list (car x) (cadr x)))
		   (car box)
		 )
	       ) ;_ end of vlax-safearray-fill
	       (vlax-safearray-fill
		 (vlax-make-safearray
		   vlax-vbDouble
		   '(0 . 1)
		 ) ;_ end of vlax-make-safearray
		 ((lambda (x) (list (car x) (cadr x)))
		   (cadr box)
		 )
	       ) ;_ end of vlax-safearray-fill
	     ) ;_ end of vla-SetWindowToPlot
	     (vla-put-PlotType lay acWindow)
	     (vla-put-PlotRotation
	       lay
	       (if
		 (apply
		   (function >)
		   (cdr
		     (reverse (mapcar (function -) (cadr box) (car box)))
		   ) ;_ end of cdr
		 ) ;_ end of apply
		  ac0degrees
		  ac90degrees
	       ) ;_ end of if
	     ) ;_ end of vla-put-PlotRotation
	     (
	      (lambda (lst / var_lst cur_val_lst temp_val_lst)
		(setq var_lst	   (mapcar (function car) lst)
		      temp_val_lst (mapcar (function cdr) lst)
		      cur_val_lst  (mapcar (function getvar) var_lst)
		) ;_ end of setq
		(mapcar (function setvar) var_lst temp_val_lst)
		(vl-cmdf "_.plot" "_no" "" "" "" "_no" "_no" "_yes")
		(mapcar (function setvar) var_lst cur_val_lst)
	      ) ;_ end of lambda
	       (list (cons "cmdecho" 0))
	     )
	   ) ;_ end of foreach
	 ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of progn
    (princ
      "\nРабота программы невозможна - текущая вкладка не содержит объектов!"
    ) ;_ end of princ
  ) ;_ end of if
  (princ)
) ;_ end of defun

Но лисп работает некорректно.
Печатает четвертями, а то и восьмушками, причем только правый нижний угол.

Кулик Алексей aka kpblc · 23.11.2009, 11:29

Тема открыта. Прошу прощения, что сразу не сделал.

Do$ · 23.11.2009, 12:32

Цитата:

Сообщение от zenon

Печатает четвертями, а то и восьмушками, причем только правый нижний угол.

Хоть один пример бы. (dwg, в формате acad2004)

zenon · 23.11.2009, 12:49

Цитата:

Сообщение от Do$

Хоть один пример бы. (dwg, в формате acad2004)

например вот
сам файл
Пример.dwg
выбор по блоку

Нажмите на изображение для увеличения
Название: Vibor_pechat.JPG
Просмотров: 180
Размер: 18.3 Кб
ID: 29429

и собсно результат
Результат.pdf

Do$ · 23.11.2009, 12:58

Это то, о чем писал Алексей:

Цитата:

Сообщение от Кулик Алексей aka kpblc

Из обработки напрочь исключаются атрибуты; не учитывается поворот и немировая система координат; не рассматривается вопрос масштаба, не равного 1.0 хотя бы по одному из направлений.

В приложенном чертеже блоки растянуты, а печатает, как будто масштаб блока 1:1.

zenon · 23.11.2009, 13:41

Do$, то-исть это не лечится??
ps эх а шастье было так близко

Do$ · 23.11.2009, 14:06

Лечится, только сразу не смогу сказать как. Подумать надо.
Обновление:
Вопрос масштаба решил. Поворот и атрибуты пока не трогал (может и не буду). По идее, с немировой системой координат тоже проблем не должно быть.

Код:

[Выделить все]

(defun c:easyplot (/		     MGetBoundingBox
		   plotter-format-dialog
		   Table	     _dwgru-conv-pickset-to-list
		   ent		     ss
		   str		     adoc
		   box		     lay
		   plot_paper_name   plot
		  )

  (defun MGetBoundingBox (ename			 /
			  GetBoundingBox	 GetBoundingBox_dynblock
			  Spline_getBoundingBox
			 )

    (defun GetBoundingBox (en / obj minpt maxpt)
      (if (= (type en) 'ENAME)
	(progn
	  (setq obj (vlax-ename->vla-object en))
	  (vla-getboundingbox obj 'minpt 'maxpt)
	  (list
	    (vlax-safearray->list minpt)
	    (vlax-safearray->list maxpt)
	  ) ;_ end of list
	) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of defun


    (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









    (defun Spline_getBoundingBox (obj	      /		  c_pt_lst
				  cd_pt_lst   ex_pt_lst	  cls_pt_lst
				  p_lst	      divid	  spline_extr
				 )


      (defun spline_extr (obj pst / it)
			 ;|
Функция поиска экстремума сплайна на основе метода Ньютона.
Исходные параметры:
 obj - VLA-OBJECT или ENAME вида: #<VLA-OBJECT IAcadSpline 05548644> или <Entity name: 7ef65fb8>
 pst - параметр сплайна в точке начального приближения к экстремуму, действительное число

Возвращаемые значения:
 Список вида: (параметр1 параметр2 параметр3)
 параметр 1(2,3) может быть действительным положительным числом или nil, если экстремум
 не был найден (метод не сошелся).
 Примеры: (137.199 173.728 147.543)
	  (nil nil 219.258)

Пример вызова:
(spline_extr
  (setq	obj
	 (vlax-ename->vla-object
	   (car (entsel "\nВыберите сплайн:"))
	 ) ;_ end of vlax-ename->vla-object
  ) ;_ end of setq
  (vlax-curve-getParamAtPoint
    obj
    (getpoint "\nУкажите точку на сплайне:")
  ) ;_ end of vlax-curve-getParamAtPoint
) ;_ end of spline_extr
|;
	(if pst
	  (mapcar
	    (function
	      (lambda (cadrs / f df p)
		(setq it 0
		      p	 pst
		) ;_ end of setq
		(while (not (or	(equal f 0.0 1.0e-008)
				(equal df 0.0 1.0e-008)
				(> it 10)
			    ) ;_ end of or
		       ) ;_ end of not
		  (setq	it (1+ it)
			f  ((eval cadrs) (vlax-curve-getfirstderiv obj p))
			df ((eval cadrs) (vlax-curve-getsecondderiv obj p))
			p  (if (equal df 0.0 1.0e-008)
			     p
			     (- p (/ f df))
			   ) ;_ end of if
		  ) ;_ end of setq
		) ;_ end of while
		(if (or	(< p (vlax-curve-getStartParam obj))
			(> p (vlax-curve-getEndParam obj))
			(> it 10)
		    ) ;_ end of or
		  nil
		  p
		) ;_ end of if
	      ) ;_ end of lambda
	    ) ;_ end of function
	    (list car cadr caddr)
	  ) ;_ end of mapcar
	) ;_ end of if
      ) ;_ end of defun

      (defun divid (pt1 pt2 n)
		   ;|
    Функция нахождения точек, делящих отрезок
    на заданное количество равных частей.

Исходные параметры:
    pt1 - начало отрезка
    pt2 - конец отрезка
    n - количество частей

Пример вызова:
    (divid '(0.0 0.0 0.0) '(15.0 15.0 15.0) 3)
    (divid '(0.0 0.0) '(12.0 12.0) 4)

Возвращаемое значение - список точек вида:
    ((5.0 5.0 5.0) (10.0 10.0 10.0))
    ((3.0 3.0) (6.0 6.0) (9.0 9.0))
|;
	(mapcar
	  '(lambda (c)
	     (mapcar '(lambda (a b) (+ (* c (/ (- a b) n)) b)) pt2 pt1)
	   ) ;_ end of lambda
	  (
	   (lambda (d / rez)
	     (repeat (setq d (1- d))
	       (setq rez (cons d rez)
		     d	 (1- d)
	       ) ;_ end of setq
	     ) ;_ end of repeat
	     rez
	   ) ;_ end of lambda
	    n
	  )
	) ;_ end of mapcar
      ) ;_ end of defun

      (if (= (type obj) 'ENAME)
	(setq obj (vlax-ename->vla-object obj))
      ) ;_ end of if
      (setq c_pt_lst   (mapcar
			 '(lambda (x)
			    (vlax-safearray->list
			      (vlax-variant-value
				(vla-getcontrolpoint obj x)
			      ) ;_ end of vlax-variant-value
			    ) ;_ end of vlax-safearray->list
			  ) ;_ end of lambda
			 ((lambda (/ n lst)
			    (repeat
			      (1- (setq
				    n (1- (vla-get-NumberOfControlPoints obj))
				  ) ;_ end of setq
			      ) ;_ end of 1-
			       (setq
				 n   (1- n)
				 lst (cons n lst)
			       ) ;_ end of setq
			    ) ;_ end of repeat
			    lst
			  ) ;_ end of lambda
			 )
		       ) ;_ end of mapcar
	    cd_pt_lst  ((lambda	(lst / rez)
			  (while lst
			    (if	(cadr lst)
			      (setq
				rez (append
				      rez
				      (cons (car lst)
					    (divid (car lst) (cadr lst) 3)
				      ) ;_ end of cons
				    ) ;_ end of append
			      ) ;_ end of setq
			      (setq rez (append rez lst))
			    ) ;_ end of if
			    (setq lst (cdr lst))
			  ) ;_ end of while
			  rez
			) ;_ end of lambda
			 c_pt_lst
		       )
	    cls_pt_lst (mapcar
			 '(lambda (pt)
			    (vlax-curve-getclosestpointto obj pt)
			  ) ;_ end of lambda
			 cd_pt_lst
		       ) ;_ end of mapcar
	    p_lst      (vl-remove-if
			 'not
			 (apply
			   'append
			   (mapcar
			     (function (lambda (x)
					 (spline_extr
					   obj
					   (vlax-curve-getParamAtPoint obj x)
					 ) ;_ end of spline_extr
				       ) ;_ end of lambda
			     ) ;_ end of function
			     cls_pt_lst
			   ) ;_ end of mapcar
			 ) ;_ end of apply
		       ) ;_ end of vl-remove-if
	    ex_pt_lst  (append
			 (list
			   (vlax-curve-getStartPoint obj)
			   (vlax-curve-getEndPoint obj)
			 ) ;_ end of list
			 (mapcar
			   (function
			     (lambda (p) (vlax-curve-getPointAtParam obj p))
			   ) ;_ end of function
			   p_lst
			 ) ;_ end of mapcar
		       ) ;_ end of append
      ) ;_ end of setq
      (mapcar
	(function
	  (lambda (mins)
	    (mapcar
	      (function	(lambda	(cadrs)
			  (apply (function mins)
				 (mapcar (function cadrs) ex_pt_lst)
			  ) ;_ 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
    ) ;_ end of defun

    (mapcar
      (function	(lambda	(a)
		  (mapcar (function (lambda (b)
				      (if (equal b 0.0 1.0e-007)
					0.0
					b
				      ) ;_ end of if
				    ) ;_ end of lambda
			  ) ;_ end of function
			  a
		  ) ;_ end of mapcar
		) ;_ end of lambda
      ) ;_ end of function
      (cond
	((and
	   (= (cdr (assoc 0 (entget ename))) "INSERT")
	   (vlax-property-available-p
	     (vlax-ename->vla-object ename)
	     'isdynamicblock
	   ) ;_ end of vlax-property-available-p
	   (equal (vla-get-isdynamicblock (vlax-ename->vla-object ename))
		  :vlax-true
	   ) ;_ end of equal
	 ) ;_ end of and
	 (GetBoundingBox_dynblock ename)
	)
	((= (cdr (assoc 0 (entget ename))) "SPLINE")
	 (Spline_getBoundingBox ename)
	)
	(T (GetBoundingBox ename))
      ) ;_ end of cond
    ) ;_ end of mapcar
  ) ;_ end of defun

  (defun plotter-format-dialog
			       (lay	      /
				easyplot-action-fun
				run_dialog    fo
				fn	      plot_names
				paper_name
			       )

    (defun easyplot-action-fun (key value data reason x y)
      (cond
	((= key "plot_names")
	 (setq plot_name (nth (atoi value) plot_names))
	 (done_dialog 2)
	)
	((= key "accept")
	 (setq paper_name
		(cdr
		  (nth (atoi (get_tile "paper_names")) paper_names)
		) ;_ end of cdr
	 ) ;_ end of setq
	 (done_dialog 1)
	)
	((= key "cancel") (setq paper_name 0) (done_dialog 3))
      ) ;_ end of cond
    ) ;_ end of defun

    (defun run_dialog (file dlg rexp action / dl1)
      (if (and (= (type file) (type dlg) 'STR)
	       (= (type rexp) 'LIST)
	  ) ;_ end of and
	(if (> (setq dl1 (load_dialog file)) 0)
	  (progn
	    (if	(new_dialog dlg dl1 action)
	      (progn
		(if
		  (vl-catch-all-error-p (vl-catch-all-apply rexp))
		   (progn
		     (princ "\nОшибка в выражении!")
		     (term_dialog)
		     (unload_dialog dl1)
		   ) ;_ end of progn
		   (progn
		     (start_dialog)
		     (unload_dialog dl1)
		   ) ;_ end of progn
		) ;_ end of if
	      ) ;_ end of progn
	      (alert
		(strcat
		  "В файле: \""		     file
		  "\"\nне найдено описания диалога:\n\""
		  dlg			     "\""
		 ) ;_ end of strcat
	      ) ;_ end of alert
	    ) ;_ end of if
	  ) ;_ end of progn
	  (alert (strcat "Файл: \"" file "\" не найден!"))
	) ;_ end of if
      ) ;_ end of if
    ) ;_ end of defun

    (setq
      plot_names (vl-sort
		   (vl-remove-if
		     '(lambda (a)
			(or (= (strcase a T) "none")
			    (wcmatch a "*.pc3")
			) ;_ end of or
		      ) ;_ end of lambda
		     (vlax-safearray->list
		       (vlax-variant-value (vla-GetPlotDeviceNames lay))
		     ) ;_ end of vlax-safearray->list
		   ) ;_ end of vl-remove-if
		   '<
		 ) ;_ end of vl-sort
      plot_name	 (car plot_names)
      fn	 (vl-filename-mktemp "objpr" nil ".dcl")
      fo	 (open fn "w")
    ) ;_ end of setq
    (write-line
      (strcat
	"print_device:dialog{label=\"Выбор устройства печати       \";"
	":column {:text{label=\"Выберите принтер или плоттер:\";}:popup_list{key=\"plot_names\";}"
	":text{label=\"Выберите формат/размер листа:\";}:popup_list{key=\"paper_names\";}}ok_cancel;}"
      ) ;_ end of strcat
      fo
    ) ;_ end of write-line
    (close fo)
    (while (not paper_name)
      (run_dialog
	fn
	"print_device"
	(function
	  (lambda ()
	    (start_list "plot_names")
	    (mapcar 'add_list
		    plot_names
	    ) ;_ end of mapcar
	    (end_list)
	    (set_tile "plot_names"
		      (itoa (vl-position plot_name plot_names))
	    ) ;_ end of set_tile
	    (vla-put-ConfigName lay plot_name)
	    (setq paper_names
		   (vl-sort
		     (vl-remove-if
		       '(lambda	(y)
			  (wcmatch (car y) "*Inches*,*Pixels*,~*A#*")
			) ;_ end of lambda
		       (mapcar
			 '(lambda (c)
			    (cons (vla-GetLocaleMediaName lay c) c)
			  ) ;_ end of lambda
			 (vlax-safearray->list
			   (vlax-variant-value
			     (vla-GetCanonicalMediaNames lay)
			   ) ;_ end of vlax-variant-value
			 ) ;_ end of vlax-safearray->list
		       ) ;_ end of mapcar
		     ) ;_ end of vl-remove-if
		     '(lambda (a b) (< (car a) (car b)))
		   ) ;_ end of vl-sort
	    ) ;_ end of setq
	    (start_list "paper_names")
	    (mapcar '(lambda (a) (add_list (car a)))
		    paper_names
	    ) ;_ end of mapcar
	    (end_list)
	  ) ;_ end of lambda
	) ;_ end of function
	"(easyplot-action-fun  $key $value $data $reason $x $y)"
      ) ;_ end of run_dialog
    ) ;_ end of while
    (vl-file-delete (findfile fn))
    (if	(and (= (type paper_name) 'STR) (/= (strlen paper_name) 0))
      (progn
	(vla-put-CanonicalMediaName lay paper_name)
	(list plot_name paper_name)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun



  (defun Table (s / d r)
	       ;|
Взято с dwg.ru
written by Michael Puckett.
Вызов
(table "style")
(table "layer")
|;
    (while (setq d (tblnext s (null d)))
      (setq r (append r (list (cdr (assoc 2 d)))))
    ) ;_ end of while
  ) ;_ end of defun

  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
		  item (sslength value)
	    ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
    ) ;_ end repeat
  ) ;_ end defun

  (vl-load-com)
  (setq	adoc (vla-get-ActiveDocument (vlax-get-acad-object))
	lay  (vla-get-ActiveLayout adoc)
	plot (vla-get-plot adoc)
  ) ;_ end of setq
  (if (ssget "_X" (list (cons 410 (getvar "ctab"))))
    (progn
      (while (not ent)
	(setq ent
	       (vl-catch-all-apply
		 (function
		   (lambda ()
		     (initget "Несколько Блок _Multy Block")
		     (entsel
		       "\nУкажите объект для печати, или:[Несколько/ Блок]"
		     ) ;_ end of getkword
		   ) ;_ end of lambda
		 ) ;_ end of function
	       ) ;_ end of vl-catch-all-apply
	) ;_ end of setq
	(cond
	  ((not ent) (princ "\nНичего не указано!"))
	  ((vl-catch-all-error-p ent) (setq ent "exit"))
	  ((and (listp ent) (= (type (car ent)) 'ENAME))
	   (setq ent (list (car ent)))
	  )
	  (;|(and (= (type ent) 'STR)|;
	   (= ent "Multy")		;)
	   (setq
	     ss	(vl-catch-all-apply
		  (function (lambda ()
			      (princ "\nВыберите объекты для печати:")
			      (ssget)
			    ) ;_ end of lambda
		  ) ;_ end of function
		) ;_ end of vl-catch-all-apply
	   ) ;_ end of setq
	   (cond
	     ((not ss) (princ "\nНичего не выбрано!"))
	     ((vl-catch-all-error-p ss) (setq ent "exit"))
	     (T
	      (setq ent (_dwgru-conv-pickset-to-list ss))
	     )
	   ) ;_ end of cond
	  )
	  ((and (= (type ent) 'STR) (= ent "Block"))
	   (if
	     (ssget "_X"
		    (list (cons 0 "INSERT") (cons 410 (getvar "ctab")))
	     ) ;_ end of ssget
	      (progn
		(setq ent nil)
		(while (or (not ent) (= ent "Name"))
		  (if (/= ent "Name")
		    (setq ent
			   (vl-catch-all-apply
			     (function
			       (lambda ()
				 (initget "Имя _Name")
				 (entsel "\nУкажите блок для образца, или:[Имя]"
				 ) ;_ end of entsel
			       ) ;_ end of lambda
			     ) ;_ end of function
			   ) ;_ end of vl-catch-all-apply
		    ) ;_ end of setq
		  ) ;_ end of if
		  (cond
		    ((not ent) (princ "\nНичего не выбрано!"))
		    ((vl-catch-all-error-p ent) (setq ent "exit"))
		    ((and (listp ent)
			  (= (type (car ent)) 'ENAME)
			  (= (cdr (assoc 0 (entget (car ent)))) "INSERT")
		     ) ;_ end of and
		     (setq
		       ent
			(vl-remove-if
			  (function
			    (lambda (a)
			      (/= (vla-get-EffectiveName
				    (vlax-ename->vla-object a)
				  ) ;_ end of vla-get-EffectiveName
				  (vla-get-EffectiveName
				    (vlax-ename->vla-object (car ent))
				  ) ;_ end of vla-get-EffectiveName
			      ) ;_ end of /=
			    ) ;_ end of lambda
			  ) ;_ end of function
			  (_dwgru-conv-pickset-to-list
			    (ssget "_X"
				   (list (cons 0 "INSERT")
					 (assoc 410 (entget (car ent)))
				   ) ;_ end of list
			    ) ;_ end of ssget
			  ) ;_ end of _dwgru-conv-pickset-to-list
			) ;_ end of vl-remove-if
		     ) ;_ end of setq
		    )
		    ((and (listp ent)
			  (= (type (car ent)) 'ENAME)
			  (/= (cdr (assoc 0 (entget (car ent)))) "INSERT")
		     ) ;_ end of and
		     (princ "\nВыбранное не является блоком!")
		    )
		    ((= ent "Name")
		     (setq str
			    (vl-catch-all-apply
			      (function
				(lambda	()
				  (initget "?")
				  (getstring T "\nВведите имя блока, или:[?]")
				) ;_ end of lambda
			      ) ;_ end of function
			    ) ;_ end of vl-catch-all-apply
		     ) ;_ end of setq
		     (cond
		       ((vl-catch-all-error-p str) (setq ent "exit"))
		       ((= str "?")
			(princ "\nЧертеж содержит следующие блоки:")
			(foreach a (vl-sort (Table "Block") '<)
			  (princ (strcat "\n\"" a "\""))
			) ;_ end of foreach
			(TextPage)
		       )
		       ((and (tblsearch "Block" str)
			     (setq
			       ss (ssget "_X"
					 (list (cons 0 "INSERT")
					       (cons 2 str)
					       (cons 410 (getvar "ctab"))
					 ) ;_ end of list
				  ) ;_ end of ssget
			     ) ;_ end of setq
			) ;_ end of and
			(setq
			  ent
			   (_dwgru-conv-pickset-to-list
			     ss
			   ) ;_ end of _dwgru-conv-pickset-to-list
			) ;_ end of setq
		       )
		       (T
			(princ
			  "\nБлока с таким именем в текущей вкладке нет!"
			) ;_ end of princ
		       )
		     ) ;_ end of cond
		    )
		  ) ;_ end of cond
		) ;_ end of while
	      ) ;_ end of progn
	      (progn
		(setq ent nil)
		(princ "\nТекущая вкладка не содержит блоков!")
	      ) ;_ end of progn
	   ) ;_ end of if
	  ) ;_ end of cond
	) ;_ end of cond
      ) ;_ end of while
      (if
	(and
	  (not (and (= (type ent) 'STR) (= ent "exit")))
	  (setq plot_paper_name (plotter-format-dialog lay))
	) ;_ end of and
	 (progn
	   (mapcar '(lambda (a) (vlax-put-property lay (car a) (cdr a)))
		   (list
		     (cons "PlotType" acDisplay)
		     (cons "CenterPlot" :vlax-true)
		     (cons "PaperUnits" acMillimeters)
		     (cons "PlotHidden" :vlax-false)
		     (cons "PlotViewportBorders" :vlax-false)
		     (cons "PlotViewportsFirst" :vlax-false)
		     (cons "PlotWithLineweights" :vlax-true)
		     (cons "UseStandardScale" :vlax-true)
		     (cons "StandardScale" acVpScaleToFit)
		   ) ;_ end of list
	   ) ;_ end of mapcar
	   (if (member "monochrome.ctb"
		       (vl-sort
			 (vl-remove-if
			   (function (lambda (a) (wcmatch a "*.stb")))
			   (vlax-safearray->list
			     (vlax-variant-value
			       (vla-GetPlotStyleTableNames lay)
			     ) ;_ end of vlax-variant-value
			   ) ;_ end of vlax-safearray->list
			 ) ;_ end of vl-remove-if
			 (function <)
		       ) ;_ end of vl-sort
	       ) ;_ end of member
	     (progn
	       (vla-put-PlotWithPlotStyles lay :vlax-true) ;_ :vlax-false or :vlax-true
	       (vla-put-StyleSheet lay "monochrome.ctb")
	     ) ;_ end of progn
	     (progn
	       (vla-put-PlotWithPlotStyles lay :vlax-false)
	     ) ;_ end of progn
	   ) ;_ end of if
	   (vla-put-NumberOfCopies plot 1)
	   (foreach
		     b
		      ent
	     (setq box (MGetBoundingBox b))
	     (vla-SetWindowToPlot
	       lay
	       (vlax-safearray-fill
		 (vlax-make-safearray
		   vlax-vbDouble
		   '(0 . 1)
		 ) ;_ end of vlax-make-safearray
		 ((lambda (x) (list (car x) (cadr x)))
		   (car box)
		 )
	       ) ;_ end of vlax-safearray-fill
	       (vlax-safearray-fill
		 (vlax-make-safearray
		   vlax-vbDouble
		   '(0 . 1)
		 ) ;_ end of vlax-make-safearray
		 ((lambda (x) (list (car x) (cadr x)))
		   (cadr box)
		 )
	       ) ;_ end of vlax-safearray-fill
	     ) ;_ end of vla-SetWindowToPlot
	     (vla-put-PlotType lay acWindow)
	     (vla-put-PlotRotation
	       lay
	       (if
		 (apply
		   (function >)
		   (cdr
		     (reverse (mapcar (function -) (cadr box) (car box)))
		   ) ;_ end of cdr
		 ) ;_ end of apply
		  ac0degrees
		  ac90degrees
	       ) ;_ end of if
	     ) ;_ end of vla-put-PlotRotation
	     (
	      (lambda (lst / var_lst cur_val_lst temp_val_lst)
		(setq var_lst	   (mapcar (function car) lst)
		      temp_val_lst (mapcar (function cdr) lst)
		      cur_val_lst  (mapcar (function getvar) var_lst)
		) ;_ end of setq
		(mapcar (function setvar) var_lst temp_val_lst)
		(vl-cmdf "_.plot" "_no" "" "" "" "_no" "_no" "_yes")
		(mapcar (function setvar) var_lst cur_val_lst)
	      ) ;_ end of lambda
	       (list (cons "cmdecho" 0))
	     )
	   ) ;_ end of foreach
	 ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of progn
    (princ
      "\nРабота программы невозможна - текущая вкладка не содержит объектов!"
    ) ;_ end of princ
  ) ;_ end of if
  (princ)
) ;_ end of defun

zenon · 26.11.2009, 10:25

Do$, прожка нормально работает, как и упоминал поворот блока и атрибуты не обрабатываются.
ps А вот поворот Мтекста отлично обрабатывается.
pss а можно запрос при выборе

Цитата:

Укажите объект для печати, или:[Несколько/ Блок]

повесить на правую кнопку мыши?

Do$ · 26.11.2009, 20:46

Цитата:

Сообщение от zenon

ps А вот поворот Мтекста отлично обрабатывается.

Я думаю, что если глубже копнуть, то с мтекстом будут нелады. Например, если междустрочный интервал увеличить...
Не совсем понял насчет правой кнопки мыши. Сделать контекстное меню при нажатии ПКМ из пунктов "Несколько" и "Блок"? А не проще дин. ввод включить?

zenon · 27.11.2009, 09:48

Цитата:

Сообщение от Do$

А не проще дин. ввод включить?

три движения лишних
переключить язык
ввести букву
нажать ентер
да и привык уже к ПКМ,автоматом жму. ан нет

Do$ · 27.11.2009, 10:16

При дин. вводе можно пункты выбирать мышкой (см. рис.).
Если динамический ввод принципиально не нравится - тогда не обязательно язык переключать, команды дублируются на английском:
"Несколько": _m (_Multy)
"Блок": _b (_Block)
"Имя": _n (_Name)
Как контекстное меню на ПКМ повесить пока не представляю. Предполагаю, что нужно делать реактор на это событие, а дальше -

.
Если б был какой-то пример программы на LISP с обработкой нажатия ПКМ и выводом контекстного меню...

А попроще - может написать макрокоманду и повесить на кнопку?

Djur · 11.02.2010, 11:29

Круто!!! Очень Благодарен, за кучу сэкономленного времени)))))))))
А можно, пожалуйста, получить последние изменения, там где с дин. вводом?

))

Do$ · 12.02.2010, 09:03

В сообщении #120 последняя на данный момент версия!
Динамический ввод - это не "фишка" программы, это режим самого автокада (включается и выключается нажатием F12)

Nikolay 2 · 04.03.2010, 11:48

Цитата:

Сообщение от JokerrSergh

Можно ли как-нибудь одновременно (при одном запуске проги) печатать несколько форматов листов (например А3 и А4)?
Т.е. запускаешь прогу и выделяешь лист формата А3 и лист формата А4, и прога печатает лист А3 и лист А4.
Было бы здорово чтобы прога умела сама определять нужный формат листа по соотношению сторон этого листа (при условии, что сам лист начерчен правильно: т.е. А4=210х297, или 2100х2970 и т.п.)

Это действительно было бы то, что "врач прописал". Do$, такое возможно сделать, а то печатать приходится из файла где куча форматов от А4 до А1. Хотя, даже то что уже есть, значительно облегчает процесс печати, и за это спасибо.

Do$ · 04.03.2010, 11:55

Пожалуйста!
Будет время - поколдую. Пока недосуг.

Do$ · 10.03.2010, 16:11

Опишу как я себе это представляю:
Получается, что программа должна сама определять мало того, что формат листа, так еще и принтер, куда нужно печатать. Ведь вряд ли кто-то печатает А4 и А3 на плоттере, а А1 и А0 на принтере. То есть надо будет сделать предварительную настройку: для каждого формата задать принтер/плоттер, формат/размер листа в форме диалога.
Далее, четко размеры выдерживать не стоит. Мне думается, что все, что по размерам входит в габарит 297х210*1.5 печатать на А4, далее - от 297х210*1.5 до 420х297*1.5 печатать на А3 и т.д. То есть в любом случае на чем-нибудь напечатается.
Разграничение форматов по габаритам:
до 297х210*1.5 - А4
от 297х210*1.5 до 420х297*1.5 - А3
от 420х297*1.5 до 594х420*1.5 - А2
от 594х420*1.5 до 840х594*1.5 - А1
свыше 840х594*1.5 - А0

Nikolay 2 · 11.03.2010, 14:25

Цитата:

Сообщение от Do$

То есть надо будет сделать предварительную настройку: для каждого формата задать принтер/плоттер, формат/размер листа в форме диалога.

В принципе об этом шла речь... Типа, выбираем чертежи формата А4 и устанавливаем для них принтер ХХ, затем выбираем чертежи формата А3 и для них назначаем принтер ХХ и т.д.

ssn · 12.03.2010, 15:43

давно делал такое на ВБА. именно сначало задаём что и где печатаем, а уже потом все разносится по принтерам само в зависимости от размера форматки.
http://dwg.ru/dnl/126
работает и сейчас на ура.

Nikolay 2 · 15.03.2010, 08:54

Цитата:

Сообщение от ssn

Давно делал такое на ВБА. именно сначало задаём что и где печатаем, а уже потом все разносится по принтерам само в зависимости от размера форматки.
http://dwg.ru/dnl/126
работает и сейчас на ура.

А где найти кнопку печати? Загружается 12 панелей, но такой кнопки нет....

ssn · 15.03.2010, 20:49

http://forum.abok.ru/index.php?showtopic=28075
в последнем посте есть немного видео по макросу

Nikolay 2 · 16.03.2010, 08:00

Исторически сложилось так, что чертежи делаются в модели и оформляются СПДС GraphiCS, поэтому данная программа не подходит. Ждем результатов танцев с бубном от Do$, а пока используем лисп из #120

ssn · 16.03.2010, 17:33

на самом деле

если нарисовать саму форматку в листе, а потом её вставить в модель... все работает. просто так же исторически... в модели лежит модель... в листах сами чертежи. что бы не было соблазна у сослуживцев

а если ещё точнее... то поиск формата происходит по объёкту полилиния на слое 0 и со скейл фактором 211175. любой объект подошедший под описание рассматривается как лист. потом с него просто берутся габаритные размеры и посылаются на принтер, которому данные размеры сопоставлены. при настройке программа просто редактирует пейдж сетап (всмысле человек его редактирует как надо), потом ему присваивается имя понятное программе, и потом она посылает лист на печать с настройками этого пейдж сетапа меняя лишь граници печатаемой области для каждого нового листа
т.е. если рамку сделать полилинией как надо... то впринципе, рисовать форматки программой не обязательно. так же понятно, что области печати можно просто копировать
единственно, что у меня не получилось сделать совсем красиво, это надо при настройке вручную создавать этот пейд сетап с именем 1. вероятно можно победить, и скорее всего не так сложно, но... почему то у меня не получилось.
а так, один раз в шаблон сохраняем все принтеры, и каждый новый файл уже настроен и все листы посылаются куда надо

JokerrSergh · 06.05.2010, 10:14

Цитата:

Сообщение от Do$

Лечится, только сразу не смогу сказать как. Подумать надо.
Обновление:
Вопрос масштаба решил. Поворот и атрибуты пока не трогал (может и не буду). По идее, с немировой системой координат тоже проблем не должно быть.

Код:

[Выделить все]

(defun c:easyplot (/		     MGetBoundingBox
		   plotter-format-dialog
		   Table	     _dwgru-conv-pickset-to-list
		   ent		     ss
		   str		     adoc
		   box		     lay
		   plot_paper_name   plot
		  )

  (defun MGetBoundingBox (ename			 /
			  GetBoundingBox	 GetBoundingBox_dynblock
			  Spline_getBoundingBox
			 )

    (defun GetBoundingBox (en / obj minpt maxpt)
      (if (= (type en) 'ENAME)
	(progn
	  (setq obj (vlax-ename->vla-object en))
	  (vla-getboundingbox obj 'minpt 'maxpt)
	  (list
	    (vlax-safearray->list minpt)
	    (vlax-safearray->list maxpt)
	  ) ;_ end of list
	) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of defun


    (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









    (defun Spline_getBoundingBox (obj	      /		  c_pt_lst
				  cd_pt_lst   ex_pt_lst	  cls_pt_lst
				  p_lst	      divid	  spline_extr
				 )


      (defun spline_extr (obj pst / it)
			 ;|
Функция поиска экстремума сплайна на основе метода Ньютона.
Исходные параметры:
 obj - VLA-OBJECT или ENAME вида: #<VLA-OBJECT IAcadSpline 05548644> или <Entity name: 7ef65fb8>
 pst - параметр сплайна в точке начального приближения к экстремуму, действительное число

Возвращаемые значения:
 Список вида: (параметр1 параметр2 параметр3)
 параметр 1(2,3) может быть действительным положительным числом или nil, если экстремум
 не был найден (метод не сошелся).
 Примеры: (137.199 173.728 147.543)
	  (nil nil 219.258)

Пример вызова:
(spline_extr
  (setq	obj
	 (vlax-ename->vla-object
	   (car (entsel "\nВыберите сплайн:"))
	 ) ;_ end of vlax-ename->vla-object
  ) ;_ end of setq
  (vlax-curve-getParamAtPoint
    obj
    (getpoint "\nУкажите точку на сплайне:")
  ) ;_ end of vlax-curve-getParamAtPoint
) ;_ end of spline_extr
|;
	(if pst
	  (mapcar
	    (function
	      (lambda (cadrs / f df p)
		(setq it 0
		      p	 pst
		) ;_ end of setq
		(while (not (or	(equal f 0.0 1.0e-008)
				(equal df 0.0 1.0e-008)
				(> it 10)
			    ) ;_ end of or
		       ) ;_ end of not
		  (setq	it (1+ it)
			f  ((eval cadrs) (vlax-curve-getfirstderiv obj p))
			df ((eval cadrs) (vlax-curve-getsecondderiv obj p))
			p  (if (equal df 0.0 1.0e-008)
			     p
			     (- p (/ f df))
			   ) ;_ end of if
		  ) ;_ end of setq
		) ;_ end of while
		(if (or	(< p (vlax-curve-getStartParam obj))
			(> p (vlax-curve-getEndParam obj))
			(> it 10)
		    ) ;_ end of or
		  nil
		  p
		) ;_ end of if
	      ) ;_ end of lambda
	    ) ;_ end of function
	    (list car cadr caddr)
	  ) ;_ end of mapcar
	) ;_ end of if
      ) ;_ end of defun

      (defun divid (pt1 pt2 n)
		   ;|
    Функция нахождения точек, делящих отрезок
    на заданное количество равных частей.

Исходные параметры:
    pt1 - начало отрезка
    pt2 - конец отрезка
    n - количество частей

Пример вызова:
    (divid '(0.0 0.0 0.0) '(15.0 15.0 15.0) 3)
    (divid '(0.0 0.0) '(12.0 12.0) 4)

Возвращаемое значение - список точек вида:
    ((5.0 5.0 5.0) (10.0 10.0 10.0))
    ((3.0 3.0) (6.0 6.0) (9.0 9.0))
|;
	(mapcar
	  '(lambda (c)
	     (mapcar '(lambda (a b) (+ (* c (/ (- a b) n)) b)) pt2 pt1)
	   ) ;_ end of lambda
	  (
	   (lambda (d / rez)
	     (repeat (setq d (1- d))
	       (setq rez (cons d rez)
		     d	 (1- d)
	       ) ;_ end of setq
	     ) ;_ end of repeat
	     rez
	   ) ;_ end of lambda
	    n
	  )
	) ;_ end of mapcar
      ) ;_ end of defun

      (if (= (type obj) 'ENAME)
	(setq obj (vlax-ename->vla-object obj))
      ) ;_ end of if
      (setq c_pt_lst   (mapcar
			 '(lambda (x)
			    (vlax-safearray->list
			      (vlax-variant-value
				(vla-getcontrolpoint obj x)
			      ) ;_ end of vlax-variant-value
			    ) ;_ end of vlax-safearray->list
			  ) ;_ end of lambda
			 ((lambda (/ n lst)
			    (repeat
			      (1- (setq
				    n (1- (vla-get-NumberOfControlPoints obj))
				  ) ;_ end of setq
			      ) ;_ end of 1-
			       (setq
				 n   (1- n)
				 lst (cons n lst)
			       ) ;_ end of setq
			    ) ;_ end of repeat
			    lst
			  ) ;_ end of lambda
			 )
		       ) ;_ end of mapcar
	    cd_pt_lst  ((lambda	(lst / rez)
			  (while lst
			    (if	(cadr lst)
			      (setq
				rez (append
				      rez
				      (cons (car lst)
					    (divid (car lst) (cadr lst) 3)
				      ) ;_ end of cons
				    ) ;_ end of append
			      ) ;_ end of setq
			      (setq rez (append rez lst))
			    ) ;_ end of if
			    (setq lst (cdr lst))
			  ) ;_ end of while
			  rez
			) ;_ end of lambda
			 c_pt_lst
		       )
	    cls_pt_lst (mapcar
			 '(lambda (pt)
			    (vlax-curve-getclosestpointto obj pt)
			  ) ;_ end of lambda
			 cd_pt_lst
		       ) ;_ end of mapcar
	    p_lst      (vl-remove-if
			 'not
			 (apply
			   'append
			   (mapcar
			     (function (lambda (x)
					 (spline_extr
					   obj
					   (vlax-curve-getParamAtPoint obj x)
					 ) ;_ end of spline_extr
				       ) ;_ end of lambda
			     ) ;_ end of function
			     cls_pt_lst
			   ) ;_ end of mapcar
			 ) ;_ end of apply
		       ) ;_ end of vl-remove-if
	    ex_pt_lst  (append
			 (list
			   (vlax-curve-getStartPoint obj)
			   (vlax-curve-getEndPoint obj)
			 ) ;_ end of list
			 (mapcar
			   (function
			     (lambda (p) (vlax-curve-getPointAtParam obj p))
			   ) ;_ end of function
			   p_lst
			 ) ;_ end of mapcar
		       ) ;_ end of append
      ) ;_ end of setq
      (mapcar
	(function
	  (lambda (mins)
	    (mapcar
	      (function	(lambda	(cadrs)
			  (apply (function mins)
				 (mapcar (function cadrs) ex_pt_lst)
			  ) ;_ 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
    ) ;_ end of defun

    (mapcar
      (function	(lambda	(a)
		  (mapcar (function (lambda (b)
				      (if (equal b 0.0 1.0e-007)
					0.0
					b
				      ) ;_ end of if
				    ) ;_ end of lambda
			  ) ;_ end of function
			  a
		  ) ;_ end of mapcar
		) ;_ end of lambda
      ) ;_ end of function
      (cond
	((and
	   (= (cdr (assoc 0 (entget ename))) "INSERT")
	   (vlax-property-available-p
	     (vlax-ename->vla-object ename)
	     'isdynamicblock
	   ) ;_ end of vlax-property-available-p
	   (equal (vla-get-isdynamicblock (vlax-ename->vla-object ename))
		  :vlax-true
	   ) ;_ end of equal
	 ) ;_ end of and
	 (GetBoundingBox_dynblock ename)
	)
	((= (cdr (assoc 0 (entget ename))) "SPLINE")
	 (Spline_getBoundingBox ename)
	)
	(T (GetBoundingBox ename))
      ) ;_ end of cond
    ) ;_ end of mapcar
  ) ;_ end of defun

  (defun plotter-format-dialog
			       (lay	      /
				easyplot-action-fun
				run_dialog    fo
				fn	      plot_names
				paper_name
			       )

    (defun easyplot-action-fun (key value data reason x y)
      (cond
	((= key "plot_names")
	 (setq plot_name (nth (atoi value) plot_names))
	 (done_dialog 2)
	)
	((= key "accept")
	 (setq paper_name
		(cdr
		  (nth (atoi (get_tile "paper_names")) paper_names)
		) ;_ end of cdr
	 ) ;_ end of setq
	 (done_dialog 1)
	)
	((= key "cancel") (setq paper_name 0) (done_dialog 3))
      ) ;_ end of cond
    ) ;_ end of defun

    (defun run_dialog (file dlg rexp action / dl1)
      (if (and (= (type file) (type dlg) 'STR)
	       (= (type rexp) 'LIST)
	  ) ;_ end of and
	(if (> (setq dl1 (load_dialog file)) 0)
	  (progn
	    (if	(new_dialog dlg dl1 action)
	      (progn
		(if
		  (vl-catch-all-error-p (vl-catch-all-apply rexp))
		   (progn
		     (princ "\nОшибка в выражении!")
		     (term_dialog)
		     (unload_dialog dl1)
		   ) ;_ end of progn
		   (progn
		     (start_dialog)
		     (unload_dialog dl1)
		   ) ;_ end of progn
		) ;_ end of if
	      ) ;_ end of progn
	      (alert
		(strcat
		  "В файле: \""		     file
		  "\"\nне найдено описания диалога:\n\""
		  dlg			     "\""
		 ) ;_ end of strcat
	      ) ;_ end of alert
	    ) ;_ end of if
	  ) ;_ end of progn
	  (alert (strcat "Файл: \"" file "\" не найден!"))
	) ;_ end of if
      ) ;_ end of if
    ) ;_ end of defun

    (setq
      plot_names (vl-sort
		   (vl-remove-if
		     '(lambda (a)
			(or (= (strcase a T) "none")
			    (wcmatch a "*.pc3")
			) ;_ end of or
		      ) ;_ end of lambda
		     (vlax-safearray->list
		       (vlax-variant-value (vla-GetPlotDeviceNames lay))
		     ) ;_ end of vlax-safearray->list
		   ) ;_ end of vl-remove-if
		   '<
		 ) ;_ end of vl-sort
      plot_name	 (car plot_names)
      fn	 (vl-filename-mktemp "objpr" nil ".dcl")
      fo	 (open fn "w")
    ) ;_ end of setq
    (write-line
      (strcat
	"print_device:dialog{label=\"Выбор устройства печати       \";"
	":column {:text{label=\"Выберите принтер или плоттер:\";}:popup_list{key=\"plot_names\";}"
	":text{label=\"Выберите формат/размер листа:\";}:popup_list{key=\"paper_names\";}}ok_cancel;}"
      ) ;_ end of strcat
      fo
    ) ;_ end of write-line
    (close fo)
    (while (not paper_name)
      (run_dialog
	fn
	"print_device"
	(function
	  (lambda ()
	    (start_list "plot_names")
	    (mapcar 'add_list
		    plot_names
	    ) ;_ end of mapcar
	    (end_list)
	    (set_tile "plot_names"
		      (itoa (vl-position plot_name plot_names))
	    ) ;_ end of set_tile
	    (vla-put-ConfigName lay plot_name)
	    (setq paper_names
		   (vl-sort
		     (vl-remove-if
		       '(lambda	(y)
			  (wcmatch (car y) "*Inches*,*Pixels*,~*A#*")
			) ;_ end of lambda
		       (mapcar
			 '(lambda (c)
			    (cons (vla-GetLocaleMediaName lay c) c)
			  ) ;_ end of lambda
			 (vlax-safearray->list
			   (vlax-variant-value
			     (vla-GetCanonicalMediaNames lay)
			   ) ;_ end of vlax-variant-value
			 ) ;_ end of vlax-safearray->list
		       ) ;_ end of mapcar
		     ) ;_ end of vl-remove-if
		     '(lambda (a b) (< (car a) (car b)))
		   ) ;_ end of vl-sort
	    ) ;_ end of setq
	    (start_list "paper_names")
	    (mapcar '(lambda (a) (add_list (car a)))
		    paper_names
	    ) ;_ end of mapcar
	    (end_list)
	  ) ;_ end of lambda
	) ;_ end of function
	"(easyplot-action-fun  $key $value $data $reason $x $y)"
      ) ;_ end of run_dialog
    ) ;_ end of while
    (vl-file-delete (findfile fn))
    (if	(and (= (type paper_name) 'STR) (/= (strlen paper_name) 0))
      (progn
	(vla-put-CanonicalMediaName lay paper_name)
	(list plot_name paper_name)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun



  (defun Table (s / d r)
	       ;|
Взято с dwg.ru
written by Michael Puckett.
Вызов
(table "style")
(table "layer")
|;
    (while (setq d (tblnext s (null d)))
      (setq r (append r (list (cdr (assoc 2 d)))))
    ) ;_ end of while
  ) ;_ end of defun

  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
		  item (sslength value)
	    ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
    ) ;_ end repeat
  ) ;_ end defun

  (vl-load-com)
  (setq	adoc (vla-get-ActiveDocument (vlax-get-acad-object))
	lay  (vla-get-ActiveLayout adoc)
	plot (vla-get-plot adoc)
  ) ;_ end of setq
  (if (ssget "_X" (list (cons 410 (getvar "ctab"))))
    (progn
      (while (not ent)
	(setq ent
	       (vl-catch-all-apply
		 (function
		   (lambda ()
		     (initget "Несколько Блок _Multy Block")
		     (entsel
		       "\nУкажите объект для печати, или:[Несколько/ Блок]"
		     ) ;_ end of getkword
		   ) ;_ end of lambda
		 ) ;_ end of function
	       ) ;_ end of vl-catch-all-apply
	) ;_ end of setq
	(cond
	  ((not ent) (princ "\nНичего не указано!"))
	  ((vl-catch-all-error-p ent) (setq ent "exit"))
	  ((and (listp ent) (= (type (car ent)) 'ENAME))
	   (setq ent (list (car ent)))
	  )
	  (;|(and (= (type ent) 'STR)|;
	   (= ent "Multy")		;)
	   (setq
	     ss	(vl-catch-all-apply
		  (function (lambda ()
			      (princ "\nВыберите объекты для печати:")
			      (ssget)
			    ) ;_ end of lambda
		  ) ;_ end of function
		) ;_ end of vl-catch-all-apply
	   ) ;_ end of setq
	   (cond
	     ((not ss) (princ "\nНичего не выбрано!"))
	     ((vl-catch-all-error-p ss) (setq ent "exit"))
	     (T
	      (setq ent (_dwgru-conv-pickset-to-list ss))
	     )
	   ) ;_ end of cond
	  )
	  ((and (= (type ent) 'STR) (= ent "Block"))
	   (if
	     (ssget "_X"
		    (list (cons 0 "INSERT") (cons 410 (getvar "ctab")))
	     ) ;_ end of ssget
	      (progn
		(setq ent nil)
		(while (or (not ent) (= ent "Name"))
		  (if (/= ent "Name")
		    (setq ent
			   (vl-catch-all-apply
			     (function
			       (lambda ()
				 (initget "Имя _Name")
				 (entsel "\nУкажите блок для образца, или:[Имя]"
				 ) ;_ end of entsel
			       ) ;_ end of lambda
			     ) ;_ end of function
			   ) ;_ end of vl-catch-all-apply
		    ) ;_ end of setq
		  ) ;_ end of if
		  (cond
		    ((not ent) (princ "\nНичего не выбрано!"))
		    ((vl-catch-all-error-p ent) (setq ent "exit"))
		    ((and (listp ent)
			  (= (type (car ent)) 'ENAME)
			  (= (cdr (assoc 0 (entget (car ent)))) "INSERT")
		     ) ;_ end of and
		     (setq
		       ent
			(vl-remove-if
			  (function
			    (lambda (a)
			      (/= (vla-get-EffectiveName
				    (vlax-ename->vla-object a)
				  ) ;_ end of vla-get-EffectiveName
				  (vla-get-EffectiveName
				    (vlax-ename->vla-object (car ent))
				  ) ;_ end of vla-get-EffectiveName
			      ) ;_ end of /=
			    ) ;_ end of lambda
			  ) ;_ end of function
			  (_dwgru-conv-pickset-to-list
			    (ssget "_X"
				   (list (cons 0 "INSERT")
					 (assoc 410 (entget (car ent)))
				   ) ;_ end of list
			    ) ;_ end of ssget
			  ) ;_ end of _dwgru-conv-pickset-to-list
			) ;_ end of vl-remove-if
		     ) ;_ end of setq
		    )
		    ((and (listp ent)
			  (= (type (car ent)) 'ENAME)
			  (/= (cdr (assoc 0 (entget (car ent)))) "INSERT")
		     ) ;_ end of and
		     (princ "\nВыбранное не является блоком!")
		    )
		    ((= ent "Name")
		     (setq str
			    (vl-catch-all-apply
			      (function
				(lambda	()
				  (initget "?")
				  (getstring T "\nВведите имя блока, или:[?]")
				) ;_ end of lambda
			      ) ;_ end of function
			    ) ;_ end of vl-catch-all-apply
		     ) ;_ end of setq
		     (cond
		       ((vl-catch-all-error-p str) (setq ent "exit"))
		       ((= str "?")
			(princ "\nЧертеж содержит следующие блоки:")
			(foreach a (vl-sort (Table "Block") '<)
			  (princ (strcat "\n\"" a "\""))
			) ;_ end of foreach
			(TextPage)
		       )
		       ((and (tblsearch "Block" str)
			     (setq
			       ss (ssget "_X"
					 (list (cons 0 "INSERT")
					       (cons 2 str)
					       (cons 410 (getvar "ctab"))
					 ) ;_ end of list
				  ) ;_ end of ssget
			     ) ;_ end of setq
			) ;_ end of and
			(setq
			  ent
			   (_dwgru-conv-pickset-to-list
			     ss
			   ) ;_ end of _dwgru-conv-pickset-to-list
			) ;_ end of setq
		       )
		       (T
			(princ
			  "\nБлока с таким именем в текущей вкладке нет!"
			) ;_ end of princ
		       )
		     ) ;_ end of cond
		    )
		  ) ;_ end of cond
		) ;_ end of while
	      ) ;_ end of progn
	      (progn
		(setq ent nil)
		(princ "\nТекущая вкладка не содержит блоков!")
	      ) ;_ end of progn
	   ) ;_ end of if
	  ) ;_ end of cond
	) ;_ end of cond
      ) ;_ end of while
      (if
	(and
	  (not (and (= (type ent) 'STR) (= ent "exit")))
	  (setq plot_paper_name (plotter-format-dialog lay))
	) ;_ end of and
	 (progn
	   (mapcar '(lambda (a) (vlax-put-property lay (car a) (cdr a)))
		   (list
		     (cons "PlotType" acDisplay)
		     (cons "CenterPlot" :vlax-true)
		     (cons "PaperUnits" acMillimeters)
		     (cons "PlotHidden" :vlax-false)
		     (cons "PlotViewportBorders" :vlax-false)
		     (cons "PlotViewportsFirst" :vlax-false)
		     (cons "PlotWithLineweights" :vlax-true)
		     (cons "UseStandardScale" :vlax-true)
		     (cons "StandardScale" acVpScaleToFit)
		   ) ;_ end of list
	   ) ;_ end of mapcar
	   (if (member "monochrome.ctb"
		       (vl-sort
			 (vl-remove-if
			   (function (lambda (a) (wcmatch a "*.stb")))
			   (vlax-safearray->list
			     (vlax-variant-value
			       (vla-GetPlotStyleTableNames lay)
			     ) ;_ end of vlax-variant-value
			   ) ;_ end of vlax-safearray->list
			 ) ;_ end of vl-remove-if
			 (function <)
		       ) ;_ end of vl-sort
	       ) ;_ end of member
	     (progn
	       (vla-put-PlotWithPlotStyles lay :vlax-true) ;_ :vlax-false or :vlax-true
	       (vla-put-StyleSheet lay "monochrome.ctb")
	     ) ;_ end of progn
	     (progn
	       (vla-put-PlotWithPlotStyles lay :vlax-false)
	     ) ;_ end of progn
	   ) ;_ end of if
	   (vla-put-NumberOfCopies plot 1)
	   (foreach
		     b
		      ent
	     (setq box (MGetBoundingBox b))
	     (vla-SetWindowToPlot
	       lay
	       (vlax-safearray-fill
		 (vlax-make-safearray
		   vlax-vbDouble
		   '(0 . 1)
		 ) ;_ end of vlax-make-safearray
		 ((lambda (x) (list (car x) (cadr x)))
		   (car box)
		 )
	       ) ;_ end of vlax-safearray-fill
	       (vlax-safearray-fill
		 (vlax-make-safearray
		   vlax-vbDouble
		   '(0 . 1)
		 ) ;_ end of vlax-make-safearray
		 ((lambda (x) (list (car x) (cadr x)))
		   (cadr box)
		 )
	       ) ;_ end of vlax-safearray-fill
	     ) ;_ end of vla-SetWindowToPlot
	     (vla-put-PlotType lay acWindow)
	     (vla-put-PlotRotation
	       lay
	       (if
		 (apply
		   (function >)
		   (cdr
		     (reverse (mapcar (function -) (cadr box) (car box)))
		   ) ;_ end of cdr
		 ) ;_ end of apply
		  ac0degrees
		  ac90degrees
	       ) ;_ end of if
	     ) ;_ end of vla-put-PlotRotation
	     (
	      (lambda (lst / var_lst cur_val_lst temp_val_lst)
		(setq var_lst	   (mapcar (function car) lst)
		      temp_val_lst (mapcar (function cdr) lst)
		      cur_val_lst  (mapcar (function getvar) var_lst)
		) ;_ end of setq
		(mapcar (function setvar) var_lst temp_val_lst)
		(vl-cmdf "_.plot" "_no" "" "" "" "_no" "_no" "_yes")
		(mapcar (function setvar) var_lst cur_val_lst)
	      ) ;_ end of lambda
	       (list (cons "cmdecho" 0))
	     )
	   ) ;_ end of foreach
	 ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of progn
    (princ
      "\nРабота программы невозможна - текущая вкладка не содержит объектов!"
    ) ;_ end of princ
  ) ;_ end of if
  (princ)
) ;_ end of defun

Вопрос от чайника: Как изменить масштаб печати? По умолчанию в лиспе стоит "вписать", а мне нужно чтобы можно было установить другой масштаб. Как это сделать? Где и что поменять в лиспе?

Do$ · 06.05.2010, 10:40

Собсна, идея программы тогда теряется... Но если надо, то меняй строчки:

Код:

[Выделить все]

(cons "UseStandardScale" :vlax-true)
(cons "StandardScale" acVpScaleToFit)

на что-то другое.
Кстати, раз уж тему подняли...
У программы обнаружился баг, по крайней мере у меня возникает:
Если печатать из файла, с которого еще не проводилась печать стандартными средствами, то иногда листы печатаются с серой надписью [none] по диагонали. Достаточно один раз использовать команду PLOT, после этого печатается без лишних надписей. Может кто подскажет, в чем может быть дело?

JokerrSergh · 06.05.2010, 11:25

Цитата:

Сообщение от Do$

Собсна, идея программы тогда теряется... Но если надо, то меняй строчки:

Код:

[Выделить все]

(cons "UseStandardScale" :vlax-true)
(cons "StandardScale" acVpScaleToFit)

на что-то другое.

на что другое? Если мне нужно чтобы 1мм = 1.02 ед. чертежа
на что мне поменять эти строчки? Это фиксированный масштаб, которым я обычно печатаю

Do$ · 06.05.2010, 12:15

Цитата:

Сообщение от JokerrSergh

Если мне нужно чтобы 1мм = 1.02 ед. чертежа

Таких масштабов не существует. Это наподобие 1км = 3 литра. Единицы чертежа какие?
Вот блин, а ведь действительно при печати есть такие масштабы, вот ведь бред...
Тогда значит так:
Вместо

Код:

[Выделить все]

(cons "UseStandardScale" :vlax-true)

пишем

Код:

[Выделить все]

(cons "UseStandardScale" :vlax-false)

удаляем или закомментируем строчку:

Код:

[Выделить все]

(cons "StandardScale" acVpScaleToFit)

, и после этой конструкции:

Код:

[Выделить все]

(mapcar '(lambda (a) (vlax-put-property lay (car a) (cdr a)))
           (list
             (cons "PlotType" acDisplay)
             (cons "CenterPlot" :vlax-true)
             (cons "PaperUnits" acMillimeters)
             (cons "PlotHidden" :vlax-false)
             (cons "PlotViewportBorders" :vlax-false)
             (cons "PlotViewportsFirst" :vlax-false)
             (cons "PlotWithLineweights" :vlax-true)
             (cons "UseStandardScale" :vlax-true)
             (cons "StandardScale" acVpScaleToFit)
           ) ;_ end of list
       ) ;_ end of mapcar

Добавляем строчку:

Код:

[Выделить все]

(vla-SetCustomScale lay 1 1.02)

Сохраняем изменения, и пробуем

JokerrSergh · 07.05.2010, 05:49

DO$
вот теперь то, что нужно, всё работает

пока багов не замечал, даже при первом распечатывании твоим лиспом всё ништятски печатается.
Спасибо огромное!!!

Do$ · 07.05.2010, 08:22

Ну и славненько

На здоровье!

Цитата:

Сообщение от JokerrSergh

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

Может быть у меня с автокадом что-то

JokerrSergh · 27.04.2011, 11:03

Программа просто супер, очень доволен её работой и создателю огромный респект!!!
За время эксплуатации обнаружился один баго и возникла пара вопросов:
Баг: иногда распечатываются пустые листы. Наблюдается в файлах, в которых работали несколько человек (сначала строители, потом технологи и энергетики). У всех свои слои и стандарты оформления чертежей- наверное из-за перенасыщенности вылазиет баг. Если листы скопировать в новый файл и печатать из него, то всё печатается нормально.
Автокад 2007 русский пиратский

Опыт показывает, что пользователь использует при печати всего два-три типа принтера и два-три формата бумаги.
В связи с чем возникают вопросы:
1) Как убрать ненужные принтеры из списка? Или вернее, как оставить только 2-3 нужных принтера в списке?
2) Как оставить только нужные форматы?

Просьба объяснить подробно для чайника, не ориентирующегося в тексте лиспа.
Лисп прилагается (там установлен масштаб печати 1:1.02 согласно инструкции из поста #139)

Do$ · 27.04.2011, 12:36

Прикладывайте чертеж с подробным описанием действий, при котором этот баг проявляется, буду разбираться.
Программа и так отбрасывает все конфигурации принтеров/плоттеров (pc3), оставляя только установленные в системе принтеры/плоттеры. Форматы тоже фильтруются и остаются только те, которые имеют в названии обозначения стандартных форматов (А4,А3,А2 и т.п.). Неужели их так много? Чтож, можно будет, наверное, добавить какие-то настройки по умолчанию...
А вообще, пользуйтесь лучше листами, пакетной печатью и подшивками

JokerrSergh · 27.04.2011, 13:34

Цитата:

Сообщение от Do$

Чтож, можно будет, наверное, добавить какие-то настройки по умолчанию...

Было бы очень здорово!

Только нужно сделать, чтобы эти настройки вылазили не при каждом нажатии на кнопку печать, например, отдельным лиспом эти настройки сделать. Хочу изменить принтер, или формат - запускаю лисп и изменяю умолчания.
Там обязательно должен быть выбор масштаба, т.к. при печати на бумаге через принтер и при печати через Adobe PDF нужно устанавливать разные коэффициенты масштабирования.
Там обязательно должен быть выбор принтера и форматов бумаги по умолчанию.
А для полного счастья можно сделать чтобы программа запоминала бы несколько конфигураций по умолчанию (четырех будет достаточно: например
1) принтер 1 формат, А3, масштаб 1:1.02
2) принтер 1 формат, А3, масштаб 1:1
3) принтер 2 формат, А3, масштаб 1:1.02
4) принтер 2 формат, А3, масштаб 1:1) и при нажатии на кнопку печать спрашивала бы какую из них нужно использовать.
при нажатии на кнопку печать - имеется в виду печать через Lisp

Чертеж приложил.
Подробное описание действий:
1. Открываю файлик.
2. Печатаю с использованием лиспа Easyplot.
3. Из принтера вылазиют пустые листы.

P.S.
Чистка командой _purge не решает проблему.
Печать стандартной командой _plot перед использованием лиспа тоже не помогает.
Помогает лишь копирование всех листов из этого файла в новый девственно чистый файл.

Do$ · 29.04.2011, 10:55

Какая-то, видимо, тонкость с заданием свойств печати... В программе ошибки не нашел - все работает как и было задумано. А вот в файле явно что-то надо искать такое, что влияет на печать: какую-нибудь системную переменную хитрую или может в словарях что-то зарыто коварное...
Пока откопать ничего не удалось. Может кто подскажет, в чем может быть дело? Или хотя бы направление, куда нужно копать?

JokerrSergh · 29.04.2011, 11:51

По переменным и словарям я не помощник, могу лишь описать манипуляции, производимые с файлом.
Изначально файл либо с нуля создается, либо открывается какой-либо шаблон (на этом этапе из пустого файла и из шаблона всё печатается нормально). Затем в этот файл может добавляться (как правило, копироваться) из других файлов всё, что угодно: изображения jpg, объекты СПДС разных версий и т.п. В результате такой работы (файлом по сети поочередно пользуются несколько человек) происходит этот баг. При чем не всегда происходит. Пытался найти закономерность его появления - не смог.
Описал всё, что мог

RiderPSV · 03.10.2011, 12:57

Ребята, не поверите, но чтобы варианты ответов на запросы появлялись в контекстном меню достаточно указать варианты в квадратных скобках.
Пример:
Заменить строку:
"\nУкажите объект для печати, или:[Несколько/ Блок]"
на строку:
"\nУкажите объект для печати, или [Несколько/Блок]:"

Пробуйте и совершенствуйте свою программу. Я начал ее использовать=)
Вам всем спасибо!

Pastor · 03.10.2011, 15:02

Цитата:

Ребята, не поверите...

Не поверим! Быть такого не может

Do$ · 03.10.2011, 15:30

Цитата:

Сообщение от RiderPSV

Заменить строку:
"\nУкажите объект для печати, или:[Несколько/ Блок]"
на строку:
"\nУкажите объект для печати, или [Несколько/Блок]:"

У меня оба варианта одинаково работают в AutoCAD 2010. Может быть в более ранних версиях есть разница.
Кажется понял о чем речь - имеется в виду контекстное меню по ПКМ. Действительно, с исходной строкой его нет, с исправленной - есть.
RiderPSV,

RiderPSV · 03.10.2011, 18:42

Кстати, хотел скачать текст скрипта из сообщения #120, но так его там и не нашел. В итоге пришлось брать текст из сообщения #142 и переделывать обратно. Чтобы люди не мучались выложите LISP файл с текстом программы, в которой не задан масштаб 1.02, а стоит "Вписать".
P/S листом начал интересоваться только первый день, так что если что не так сказал - извиняйте.
И еще заметил проблему (по-моему): Программа отображает список принтеров, НО(!) она не показывает в этом списке принтеры с расширением *.pc3
Это как-то можно исправить?
Do$, спасибо тебе и другим авторам текста за программу!

Лиспер · 03.10.2011, 20:15

Цитата:

Сообщение от RiderPSV

хотел скачать текст скрипта из сообщения #120, но так его там и не нашел.

Включи скрипты в браузере, перезагрузи страницу и нажми на "+" в #120.

Do$ · 05.10.2011, 09:40

Цитата:

Сообщение от RiderPSV

И еще заметил проблему (по-моему): Программа отображает список принтеров, НО(!) она не показывает в этом списке принтеры с расширением *.pc3

Так специально сделано в программе, потому что были сложности с pc3 конфигурациями. Печать осуществляется командным методом и альтернативы этому нет, а некоторые pc3 плоттеры имеют отличный от стандартного набор команд для печати. Поэтому не стал разбираться с каждым индивидуально, а просто их отфильтровал.

adu · 07.10.2011, 13:42

День добрый! Спасибо огромное Вам за программу, очень нужная штука, и работает прекрасно. Только можно было бы включить в диалог с параметрами печати поле для ввода количества копий для распечатки? Очень облегчило бы работу.

gest · 14.09.2012, 09:08

Do$ возможно продолжить развитие программы, несколько мелких плюшек здорово облегчит жизнь.
- добавление принтера по умолчанию;
- количество копий.

Do$ · 14.09.2012, 10:59

Чесслово, устал я уже открещиваться от этой программы

Дело в том, что ни я, ни мои коллеги ею не пользуемся. Поэтому, учитывая, что времени катострофически ни на что не хватает

, сейчас занимаюсь только первостепенными задачами. Если вдруг сложатся воедино факторы: свободное время, доступность компьютера с автокадом и филантропическое настроение, то я могу поковырять программу и внести в нее те изменения, которых вы желаете. Но вероятность этого в ближайшее время очень мала

.
Если вдруг кто другой захочет в ней поковыряться - я обеими руками за, при необходимости могу разъяснить что к чему в ней.
Прошу понять и простить

Fazeroid · 03.10.2012, 17:12

Добрый день! Может, кто подскажет можно ли посредствам Autolisp (автоматически) назначить имя файла (в окне сохранения PDF) при выводе на печать через PDF из пространства модели или листа. У меня есть программа, которая нормально печатает листы из пространства модели и листа, но одно но. При печати в PDF приходится для каждого листа прописывать имя файла в окне сохранения PDF вручную. Я хочу автоматизировать полностью этот процесс и от этого уйти, но пока не знаю как. Если кто знает решение данного вопроса, прошу помочь.

Do$ · 04.10.2012, 01:14

Цитата:

Сообщение от Fazeroid

Может, кто подскажет можно ли посредствам Autolisp (автоматически) назначить имя файла (в окне сохранения PDF) при выводе на печать через PDF из пространства модели или листа.

Начинаем гадать:
Печать выполняется командными методами?
Скорее всего да.
Команда печати _.-PLOT?
Наверное так.
Тогда не понятно в чем проблема, имя файла указывается на соответствующий запрос и все.

Fazeroid · 04.10.2012, 08:48

Спасибо за ответ! Но, к сожалению, в командной строке автокад не запрашивает имя файла, а выдает окно, где предлагает выбрать место и имя сохранения файла.
Вот такой порядок выводит акад в командной строке при печати:
Команда: 'VLIDE _.plot Выполнить детальное задание конфигурации? [Да/Нет]
<Нет>: Выполнить детальное задание конфигурации? [Да/Нет] <Нет>: Д
Имя листа или [?] <Модель>:
Имя устройства вывода или [?] <Adobe PDF.pc3>: Adobe PDF
Формат листа бумаги или [?] <A3>:
Единицы измерения размеров листа [Дюймы/Миллиметры] <Миллиметры>:
Ориентация чертежа [Книжная/Альбомная] <Книжная>: А
Перевернуть чертеж? [Да/Нет] <Нет>:
Печатаемая область [Экран/Границы/Лимиты/Вид/Рамка] <Рамка>:
Левый нижний угол рамки <1144.727941,-688.015360>: Правый верхний угол рамки
<2035.727941,-268.015360>: Масштаб печати (Миллиметры чертежа=Единицы чертежа)
или [Вписать] <Вписать>:
Смещение от начала (x,y) или [Центрировать] <Центрировать>:
Учитывать стили печати? [Да/Нет] <Да>:
Имя таблицы стилей печати или [?] (. если нет) <monochrome.ctb>:
Учитывать веса линий? [Да/Нет] <Да>:
Режим вывода тонированных ВЭ [Обычный/Каркас из предыдущих версий/Скрытие линий
из предыдущих версий/Визуальные стили/с вИзуализацией] <Как на экране>: О
Запись чертежа в файл [Да/Нет] <Н>:
Сохранить изменения параметров листа [Да/Нет]? <Н>
Перейти к печати [Да/Нет] <Д>:

После этого он выдает окно сохранения файла.
Печать идет через команду _.plot.
И еще в дополнение, как назначить путь сохранения посредством Autolisp?

bargool · 04.10.2012, 09:50

ну так перед началом -plot выставь filedia в 0, а потом верни обратно
А, я не обратил внимание, что печать идёт на Adobe PDF.pc3, тут уж настраивай сам pc3-файл, там есть соответствующие настройки.
А чем не устраивает штатный пдф-принтер (там filedia в 0 сработает, в отличие от Adobe PDF.pc3)?

Дима_ · 04.10.2012, 10:01

Цитата:

Сообщение от bargool

выставь filedia в 0

Offtop: Мы его поймали

bargool · 04.10.2012, 10:05

Offtop: Я не виноват! Это всё он!!

Fazeroid · 04.10.2012, 10:37

Печатаю я через стандартный принтер Adobe PDF, это он изначально предлагает Adobe PDF.pc3.
Даже изменение системной переменной filedia в 0 не дает никакого результата. Как появлялось окно с запросом так и появляется.
Может имя файла сохраняемого документа в PDF прописывается в кокой-нибудь системной переменной?
Хотя просмотрев список переменных я не нашел ничего похожего.

bargool · 04.10.2012, 10:41

Adobe PDF - это не стандартный автокадовский пдф-принтер. Стандартный - DWG to PDF.pc3, с ним будет работать переменная filedia. И я всегда рекомендую использовать именно его, если, конечно, у вас автокад более новой версии, чем 2008 (там ещё подглючивает).
Если вы всё ещё хотите использовать Adobe PDF - залезьте в настройки данного конктернтго pc3, в Custom properties (как они там по-русски значатся), там есть пункт про "спрашивать имя файла"

Fazeroid · 04.10.2012, 11:34

Вариант DWG to PDF.pc3 в моем случае не подходит.
Я вкратце объясню весь процесс, который я хочу запустить.
При работе в автокаде мне и моим коллегам приходится создавать большое количество листов в пространстве листа. Поясню почему. Мы используем поля для ссылок между схемами и планами. Поэтому получается, что в пространстве листа находится до 70 листов различного формата. Сами листы выполнены блоками с атрибутом (формат листа).
Я написал программку (что-то нашел в нете, а что-то дописал сам) в Lispe по распечатке листов как с пространства модели так и с пространства листа.
Так вот при распечатке в PDF (хотя можно печатать на любой принтер, установленный на комп) для каждого листа выскакивает окно сохранения файла. Я хочу уйти от этого.
В моих планах добавить в блоки листов атрибуты "Шифр проекта" и "Номер листа", которые и будут заноситься в имя файла автоматом, но как это провернуть я пока ума не приложу.
Подскажите, как это выполнить?

P.S. Работу в пространстве листа с одним листом рассматривали не однократно и отметали как неудобную в нашем случае. Все благодаря полям, которые мы широко используем в своих проектах. А они не работают между пространствами Модель-Лист или Лист-Лист.

maratovich · 04.10.2012, 13:21

Цитата:

Сообщение от Fazeroid

Так вот при распечатке в PDF для каждого листа выскакивает окно сохранения файла.

Приложите пример этих рамок.

Do$ · 06.10.2012, 00:40

Цитата:

Сообщение от Fazeroid

А они не работают между пространствами Модель-Лист или Лист-Лист.

Работают как миленькие. Ссылка в поле, я так понимаю, на объект идет. У объекта есть уникальный ID не зависимо от того в модели он или в листе. Другое дело, что пока переключаешься между вкладками прерывается выполнение любых команд, поэтому сослаться полем на объект другой вкладки бесхитростно не получается. Ctrl+C и Ctrl+V тут очень помогают

Цитата:

Сообщение от Fazeroid

Вариант DWG to PDF.pc3 в моем случае не подходит...

Так и осталось загадкой, чем не устраивает DWGtoPDF.

Иван Павлов · 06.12.2012, 17:27

Интересно, а процесс отправки листа на печать у всех такой длительный (по лиспу #120),
кажется когда сам отправляешь он реально быстрее завершает отправку.

Fazeroid · 07.12.2012, 09:17

Всем привет! Спасибо за дискуссию по моему вопросу. Программу свою я сделал и как раз через принтер DWG to PDF.pc3. За это вам спасибо. Прога работает полностью как хотел, если не брать в расчет некоторые косяки , которые предстоит исправить. Но это в процессе.

Возникла еще такая проблема.
Сделал рамки листов динамическими, но проблема программы с определением координат рамки выделения листа при печати через команду "vla-getboundingbox". Эта функция каждый раз задает размеры наибольшего из листов в динамическом блоке. Как с этим бороться подскажите кто-нибудь пожалуйста.

Do$ · 07.12.2012, 10:05

Посмотри код из #120, там есть функция по определению границ динамического блока, которую написал Кулик Алексей. Суть в том, что проверяются все объекты внутри блока на предмет видимости и граница определяется только по видимым объектам. У vla-getboundingbox есть еще другие проблемы - со сплайнами, с мультитекстом...

Fazeroid · 07.12.2012, 10:36

Цитата:

Сообщение от Do$

Посмотри код из #120, там есть функция по определению границ динамического блока, которую написал Кулик Алексей. Суть в том, что проверяются все объекты внутри блока на предмет видимости и граница определяется только по видимым объектам. У vla-getboundingbox есть еще другие проблемы - со сплайнами, с мультитекстом...

Спасибо, посмотрю.

MEsher · 07.12.2012, 11:19

Чтоб не создавать новую тему напишу вопрос здесь по DWG to PDF.

Каким-нибудь параметром можно отключить открытие созданного файла в pdf, то есть возможность тихой печати.

bargool · 07.12.2012, 11:24

Цитата:

Сообщение от MEsher

Каким-нибудь параметром можно отключить открытие созданного файла в pdf, то есть возможность тихой печати.

только ручным снятием галочки в настройках DWG to PDF.pc3

MEsher · 07.12.2012, 11:39

Цитата:

Сообщение от bargool

только ручным снятием галочки в настройках DWG to PDF.pc3

А ведь достаточно было залезть в "Дополнительные свойства". Спасибо, помогло.

RedAlex · 27.05.2013, 15:41

;Код из №14 поста работает нормально, но очень нужно превью! Правильно ли выделилось, не забыл я включить слои и т.д.

печатаем или нет, все просто оказалось.
Offtop:

Код:

[Выделить все]

 (defun c:A1color ()
(vl-load-com)
(defun GetBoundingBox (en / obj minpt maxpt)
  (if (= (type en) 'ENAME)
    (progn
      (setq obj (vlax-ename->vla-object en))
      (vla-getboundingbox obj 'minpt 'maxpt)
      (list
        (trans (vlax-safearray->list minpt) 0 1)
        (trans (vlax-safearray->list maxpt) 0 1)
      ) ;_ end of list
    ) ;_ end of progn
  ) ;_endof if progn 
) ;_endof defun

;(princ "Выберите объект для печати")
;(setq box (GetBoundingBox (car(entsel)))); список из координат минимума и максимума габаритов выбранного объекта
;(setq xy1 (car box)); координаты для определения области печати, xy1 - левая нижняя, xy2 - правая верхняя 
;(setq xy2 (car (cdr box))) 

 (setq xy1 (getpoint "\n Укажите левый нижний угол рамки (ENTER-Отказ): "))
 (setq xy2 (getpoint "\n Укажите правый верхний угол рамки (ENTER-Отказ): "))
 (setq Plot-not-prew1   "_no")
 (setq Plot-not-prew2   "_Yes")

(setq a (angle xy1 xy2));угол для вычисления ориентации листа
;;; Ориентация листа: если угол в диапазоне 45...135 или 225...315 то портрет, иначе - альбом
             (if (or (and (> a (* pi 0.25)) (< a (* pi 0.75))) (and (> a (* pi 1.25)) (< a (* pi 1.75))))
               (setq orientation "Portrait") 
               (setq orientation "Landscape") 
             ) ;_ end of if

(command "_.plot"
            
             "_Yes"
             "model" ; Имя листа или [?] <Модель>: 
             ;"HP CLJ 5550N PCL 6 A4.pc3" ;Имя устройства вывода 
             "UDC.pc3"
             ;"Universal Document Converter"
             "A1" ;Формат листа бумаги
             "Millimeters" ;Единицы измерения размеров листа
             orientation
            ; "portrait" ;Ориентация чертежа 
             "_No" ;Перевернуть чертеж?
             "_Window" ;Печатаемая область
             xy1 ;Первая точка окна 
             xy2 ;Вторая точка окна 
             "_fit" ;[Вписать]
             "_center" ;Смещение от начала (x,y) или [Центрировать]
             "_yes" ;Учитывать стили печати?
             "acad.ctb" ;Имя таблицы стилей печати
             ;"previous plot"
             "_yes" ;Учитывать веса линий?
             "As displayed" ;Режим вывода раскрашенных ВЭ
             "_No" ;Запись чертежа в файл
             "_yes" ;Сохранить изменения параметров листа
             Plot-not-prew1 ;Перейти к печати
    ) ;_ end of command
(command "_.PREVIEW" ) ;_ end of command печатаем или нет, все просто оказалось.
)

Александр Лактионов · Регистрация: 12.03.2017

это только для одного объекта, как сделать для множества рамок?

maratovich · 12.03.2017, 15:07

Цитата:

Сообщение от Александр Лактионов

это только для одного объекта, как сделать для множества рамок?

Вам сюда.

Александр Лактионов · Регистрация: 12.03.2017

К примеру 100 динамических блоков , формата А3 и чтобы за один раз сразу все распечатались ?

maratovich · 12.03.2017, 15:14

Цитата:

Сообщение от Александр Лактионов

К примеру 100 динамических блоков , формата А3 и чтобы за один раз сразу все распечатались ?

Пример приложите.

Александр Лактионов · 12.03.2017, 16:20 **Пример**

Цитата:

Сообщение от maratovich

Пример приложите.

8 рамок ,чтобы все за раз распечатались
Я понимаю, что надо создать цикл(i+1) и список всех координат max min

Сергей812 · 12.03.2017, 18:22

Поиском не пользуемся? - целая же тема про пакетную распечатку из модели есть.

valerik88 · 22.03.2017, 14:51

А я не могу понять как получить текущий принтер?
Ну или вообще как не задавать его, что бы отправляло на печать в тот принтер, который для данного чертежа установлен в окне печати?

В идеале бы научиться получать все те параметры, которые в окне печати установлены в данном чертеже и вставлять их в программе в команду _plot

ытя · 22.03.2017, 15:30

Цитата:

Сообщение от valerik88

А я не могу понять как получить текущий принтер?

Список доступных .pc3
(vl-directory-files (strcat(getvar "ROAMABLEROOTPREFIX")"Plotters\\")"*.pc3")

Do$ · 22.03.2017, 18:45

Цитата:

Сообщение от valerik88

А я не могу понять как получить текущий принтер?
Ну или вообще как не задавать его, что бы отправляло на печать в тот принтер, который для данного чертежа установлен в окне печати?

В идеале бы научиться получать все те параметры, которые в окне печати установлены в данном чертеже и вставлять их в программе в команду _plot

Тут же в теме ранее есть код, в котором это уже сделано: http://forum.dwg.ru/showpost.php?p=480876&postcount=120
Можно изменить его под свои нужды или просто использовать как шпаргалку.

valerik88 · 23.03.2017, 07:46

Цитата:

Сообщение от Do$

Тут же в теме ранее есть код, в котором это уже сделано: http://forum.dwg.ru/showpost.php?p=480876&postcount=120
Можно изменить его под свои нужды или просто использовать как шпаргалку.

Немного не то, но для моих нужд подойдёт.

valerik88 · 27.03.2017, 12:44

Написал программку для личных нужд для печати из модели. Использовал коды приведённые в этой теме.
Программка удобная, но работает только с моим блоком рамки (берёт из него формат - аттрибут FORMAT и размеры листа - атрибуты W и H, без всяких GetBoundingBox)

При запуски командой printAll просит выбрать все печатаемые рамки.
Перед печатью для каждого формата из выбранных листов предлагается выбрать принтер.
Листы сортируются по вертикале и горизонтали (на примере с блоками рамки видно)

Прикладываю лисп и свой блок рамки.
Тестировалось на Autocad 2016

baksconstructor · 27.03.2017, 12:52

Цитата:

Сообщение от valerik88

Программка удобная, но работает только с моим блоком рамки (берёт из него формат - аттрибут FORMAT и размеры листа - атрибуты W и H, без всяких GetBoundingBox)

Ну что сказать.... Реверс рамки переварил нормально.
НО см. :
ГОСТ Р 21.1101-2013
Приложение Ж (обязательное). Основные надписи и дополнительные графы к ним

а именно размер и расположение графы "Согласовано"

valerik88 · 27.03.2017, 13:10

Цитата:

Сообщение от baksconstructor

НО см. :
ГОСТ Р 21.1101-2013
Приложение Ж (обязательное). Основные надписи и дополнительные графы к ним
а именно размер и расположение графы "Согласовано"

Действительно. Поправил блок.

pant-79 · 01.05.2017, 15:53

Подниму тему, потому что более релевантной моим запросам темы поиск не выдал.
Задача печати плоских объектов из пространства модели передо мной не стоит, пользуюсь листами и вьюпортами и горя не знаю.
Но сейчас встала проблема автоматизации при создании таблиц-спецификаций с эскизами деталей в ячейках. Вручную при этом используется "плоский снимок", но у него есть куча недостатков:
1. Снимок получается 1:1, то есть блок эскиза выходит огромных размеров. Таблица его изначально ужимает до размеров ячейки, но потом при переоткрытии файла параметр "вписывание блока" ломается и таблицу разносит, как Халка при трансформации. Исправления этих косяков занимают много рабочего времени.
2. Снимок никаким образом нельзя автоматизировать, т.к. при выполнении команды вылезает диалоговое окно, которое обламывает выполнение скрипта и никакими программными методами это пока не решено (по крайней мере в лиспе и вба, в более сложные дебри типа шарпея я пока залезать не планирую).
3. Снимок не отображает данные о цвете и вообще неспособен выдать никаких стилей отображения кроме каркаса.
Отсюда возникла мысль создавать миниатюры путем печати выделенного 3D-объекта из пространства модели, точнее сохранения всего этого добра в отдельные PDF, которые потом можно запихнуть в таблицу тем или иным способом.
Принцип, вроде, тот же - getboundingbox и т.д. Но вот беда, для 3D-объектов, тем более взятых из ракурса, отличного от вида top, приведенный здесь код неприменим.
Нужно брать не две точки, а целых 8, и по ним как-то вычислять границы блока, либо вообще самостоятельно выбирать рамку объекта для печати.
Короче, нужна модификация приведенного макроса, которая:
1. Печатает 3D-объект по рамке, выбранной вручную, либо определенной более хитрым алгоритмом.
2. Сохраняет результат печати в PDF, думаю, где-то в формате А6.
3. Выдергивает этот PDF назад в чертеж, создает на его основе блок. В блоке миниатюра масштабируется до нужного размера. Размер миниатюры должен задаваться в макросе и потом подгоняться под реальные нужды.
4. Обзывает блок исходя из названия фотографируемого блока. Например, из блока "Деталь1" получается блок "ЭскизДеталь1". Чтобы потом в таблице блоков не ломать голову, где искать результат.

Думаю, под это дело можно модифицировать текущий макрос, но я пока не знаю всех подводных камней:
1. Кто знает готовое решение по печати посредством рамки, киньте ссылку, если не сложно.
2. Кто знает, как более изящно решить первый пункт макроса, т.е. создать рамку, исходя из getboundingbox в трехмерном пространстве? При этом вид на модель должен быть с произвольной "нормалью".
3. Задача предполагает обращение к файловой системе (причем, дважды). Есть уже готовые решения для этого дела на лиспе?

maratovich · 01.05.2017, 16:07

Цитата:

Сообщение от pant-79

таблиц-спецификаций с эскизами деталей в ячейках

Чё ? Это по какому такому нормативу ?

Цитата:

Сообщение от pant-79

но потом при переоткрытии файла параметр "вписывание блока" ломается и таблицу разносит, как Халка при трансформации.

Установите сервис пак, у Вас Автокад глючит, работаю с этим свойством 2009-2015 везде всё в норме.
Отсюда остальное описанное не требуется.

Цитата:

Сообщение от pant-79

Есть уже готовые решения для этого дела на лиспе?

Скорее это уже в Поиск исполнителей, с полным ТЗ и примером конечного результата.
Я конечно отдалённо понял чего требуется и сделать можно, но сложно, это серьёзный проект получится.

pant-79 · 01.05.2017, 16:12

Цитата:

Сообщение от maratovich

Установите сервис пак, у Вас Автокад глючит, работаю с этим свойством 2009-2015 везде всё в норме.
Отсюда остальное описанное не требуется.

То бишь, вы прочитали первый пункт недостатков, а остальные два проигнорировали. Если уж на то пошло, главный недостаток - второй.

Нет, исполнителей я не ищу. Я сам это все скомпоную в рабочую версию. Просто, если люди в теме и более информированы, чем я, то могут подсказать, куда копать насчет последних трех пунктов.

maratovich · 01.05.2017, 21:20

Цитата:

Сообщение от pant-79

То бишь, вы прочитали первый пункт недостатков, а остальные два проигнорировали. Если уж на то пошло, главный недостаток - второй.

Я всё полностью прочитал, собственно поэтому повторюсь:
1. Выяснить причину глюков со сбросом размеров блоков в таблице. И тогда

Цитата:

Если уж на то пошло, главный недостаток - второй.

отпадает, и недостаток превращается в достоинство.
2. Про

Цитата:

1. Снимок получается 1:1 (если с исправлением автокада)
2. Снимок никаким образом нельзя автоматизировать.
3. Снимок не отображает данные о цвете и вообще неспособен выдать никаких стилей отображения кроме каркаса.

оно так и должно работать т.к. плоский снимок это не команда автокада, а лисп, и автоматизировать его из вне не получится.

Цитата:

Нет, исполнителей я не ищу. Я сам это все скомпоную в рабочую версию. Просто, если люди в теме и более информированы, чем я, то могут подсказать, куда копать насчет последних трех пунктов.

Тогда Вам прямая дорога в Программирование если терпения хватит, т.к. Ваши пункты вопросов отношения к этой теме не имеют.

И ещё, я не зря писал

Цитата:

Сообщение от maratovich

Я конечно отдалённо понял чего требуется и сделать можно, но сложно, это серьёзный проект получится.

как надоест грабли ломать - пишите, задача решается в обход стандарта и на другом языке программирования.

pant-79 · 02.05.2017, 11:35

Цитата:

Сообщение от maratovich

отпадает, и недостаток превращается в достоинство.

Цитата:

Сообщение от maratovich

оно так и должно работать т.к. плоский снимок это не команда автокада, а лисп, и автоматизировать его из вне не получится.

Пока что, сложив А и Б, из ваших слов выходит, что на команду "плоский снимок" есть открытый код на лиспе?

pant-79 · 04.05.2017, 09:41

Вот вот. Так я и думал, что нет там никаких достоинств с точки зрения автоматизации.
Достоинство - это то, что расширяет возможности, а не ограничивает.
Пока у команды "плоский снимок" есть неубиваемое диалоговое окно, которое блокирует все возможности автоматизации использования этой команды, ни о каких достоинствах при программировании говорить не приходится. Отпадает эта команда для программиста. Просто отпадает. И приходится искать альтернативы.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Опять про печать из модели нескольких листов	gizmo_zx	Программирование	2	28.09.2010 12:33
Автоматическая печать из пространства модели	Дмитрий_В	AutoCAD	9	19.04.2006 16:52
Печать из модели	Eugenius	AutoCAD	11	03.11.2004 18:26
Печать 3-х мерной модели	Лариса	AutoCAD	5	09.06.2004 19:57

21.10.2009, 12:41		#1
Печать из модели по выбору объекта zenon Остекляем!!! Алюминим!!! Москва Регистрация: 21.02.2005 Сообщений: 3,917 Просьба не отсылать в поиск, ибо прошерстил, но не то. Что хотелось бы, выбираешь объект, а программа сама определяет габариты границы объекта и отправляет на печать все что попадает в габариты. Настройку предлагаю производить либо при первичной загрузке программы, либо предварительно настроить стиль печати. ps см. в приложении что и как. исходник.dwg __________________ Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
Просмотров: 75447