| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Печать из модели по выбору объекта

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

Ответ
Поиск в этой теме
Непрочитано 21.10.2009, 12:41 #1
Печать из модели по выбору объекта
zenon
 
Остекляем!!! Алюминим!!!
 
Москва
Регистрация: 21.02.2005
Сообщений: 3,399

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

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

исходник.dwg

__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
Просмотров: 56173
 
Непрочитано 21.10.2009, 13:02
#2
KennyMckormik


 
Регистрация: 30.08.2009
Сообщений: 189


Какой объект хочешь выбирать?
__________________
Timeo Danaos et dona ferentes :eek:
KennyMckormik вне форума  
 
Автор темы   Непрочитано 21.10.2009, 13:04
#3
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


KennyMckormik, приложение смотрел??
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 21.10.2009, 13:12
#4
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,749


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

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 21.10.2009, 13:52
#5
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


Кулик Алексей aka kpblc, насколько понял из того, что нашел там основная мысль в предварительной прорисовке рамки либо спецблока. Не то что хотелось-бы.
ps на первых порах атрибуты можно и не учитывать.
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 21.10.2009, 13:56
#6
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,881


например так:
Код:
[Выделить все]
(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)))

Последний раз редактировалось Nike, 21.10.2009 в 14:02.
Nike на форуме  
 
Автор темы   Непрочитано 21.10.2009, 14:10
#7
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


Nike, так понимаю сие определяет координаты для печати, вопрос а что с ними дальше делать??
Offtop: ps ссори за мой французский, но в программировании не силен.
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 21.10.2009, 14:15
#8
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,881


ну а дальше эти координаты в (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, например..

Последний раз редактировалось Nike, 21.10.2009 в 14:59.
Nike на форуме  
 
Автор темы   Непрочитано 21.10.2009, 14:19
#9
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


Nike, прошу прошения, но как сие использовать?? загнать как макрос на кнопку??
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 21.10.2009, 14:25
#10
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,881


Offtop: zenon, ты не знаешь, как LISP-программы использовать?
Nike на форуме  
 
Автор темы   Непрочитано 21.10.2009, 14:43
#11
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


Offtop: Nike, знаю, но твой код больше смахивает на макрос на кнопку,
здесь http://dwg.ru/art/8 как-то по другому описано.
Если не трудно распиши как и что.
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 21.10.2009, 14:52
#12
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,881


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

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


Nike, автора темы интересует программа готовая к применению
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 21.10.2009, 15:20
#14
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,881


ну вот например, для печати выбранного объекта на принтер 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:

Последний раз редактировалось Nike, 21.10.2009 в 15:30.
Nike на форуме  
 
Автор темы   Непрочитано 21.10.2009, 15:37
#15
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


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

Цитата:
Command: GetBoundingBox
Unknown command "GETBOUNDINGBOX". Press F1 for help.
Цитата:
Command: (GetBoundingBox)
; error: too few arguments
что не так??

ps хотелось-бы создать кнопку с макросом типа
Цитата:
^C^C(if (null C:<команда>)(load "<файл>"));<команда>;
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:

Последний раз редактировалось zenon, 21.10.2009 в 15:39. Причина: добавил
zenon вне форума  
 
Непрочитано 21.10.2009, 16:16
#16
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,881


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

Это же все описано в http://dwg.ru/art/8, почитае еще внимательнее
Nike на форуме  
 
Автор темы   Непрочитано 21.10.2009, 16:33
#17
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


Цитата:
Сообщение от Nike Посмотреть сообщение
ну так засунь этот код в функцию, например
(defun c:zenon ()
<вышеприведенный код>
)
спасибо получилось
можно еще потретирую??
1 - выбрать 2 тип (сплайн), то почему-то габариты больше чем у требуемого прямоугольника, если это не лечится то и фиг с ним.
2 - что очень желательно, можно ли как-то заставить программу автоматически выставлять требуемую конфигурацию листа, скажем если габарит ширины требуемой области печати > габарита высоты, то ориентация листа горизонтально, иначе вертикально.


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

Последний раз редактировалось zenon, 21.10.2009 в 16:39. Причина: нашел еще багу
zenon вне форума  
 
Непрочитано 21.10.2009, 16:54
#18
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,881


А саму сообразить
это ж элементарно
Например так:

Код:
[Выделить все]
 (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 надо в помощь..

Последний раз редактировалось Nike, 21.10.2009 в 17:12.
Nike на форуме  
 
Автор темы   Непрочитано 21.10.2009, 17:38
#19
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


Nike, большой тебе спасиб
Offtop: а насчет Крыса, придется наверно позвать
ДЕ-ДУ-ШКА МО-РОЗ эээ тоисть Кулик Алексей aka kpblc
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 21.10.2009, 17:55
#20
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,881


Цитата:
Сообщение от zenon Посмотреть сообщение
Nike, большой тебе спасиб
Большой пожалуйста!
Nike на форуме  
 
Непрочитано 21.10.2009, 19:29
#21
gliv


 
Регистрация: 11.12.2007
Сообщений: 114


скажите уважаемые, а существует ли возможность создать лисп, который находил бы блоки, брал с них формат листа и соответственно выводил каждый из низ на печать.
gliv вне форума  
 
Непрочитано 21.10.2009, 20:14
#22
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,843


Цитата:
Сообщение от Nike Посмотреть сообщение
...
С первым вопросом - х.з..
С динамическими блоками тоже такую фигню видел. Как лечить - хз. Крыса & co надо в помощь..
Тут скорее винной командные методы - да да привязочки, я думаю замена
Код:
[Выделить все]
 xy1 ;Первая точка окна 
 xy2 ;Вторая точка окна
на
Код:
[Выделить все]
 "_none" xy1 ;Первая точка окна 
 "_none" xy2 ;Вторая точка окна
поможет.
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 21.10.2009, 22:04
#23
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Насчет сплайна - действительно getBoundingBox выдает точки довольно далеко от краев линии. Для печати, наверное, это не особо критично
Do$ вне форума  
 
Непрочитано 21.10.2009, 23:46
#24
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,749


Я попытался "нарисовать" код, который для сплайна будет выдавать данные по другому алгоритму, но не преуспел. Кто может - добейте:
Код:
[Выделить все]
(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
Результат неверен, говорю сразу.
Насчет дин.блоков... Там по идее надо точно так же, как и для обычных блоков (скажу честно, подобными задачами не занимался, подробный код сейчас сотворить не в силах )
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 22.10.2009, 07:45
#25
Disney

Геодезист
 
Регистрация: 12.03.2009
Сибирь (где медведи по улицам ходят)
Сообщений: 859
Отправить сообщение для Disney с помощью Skype™


Вот насочинял чуть-чуть, чтоб со сплайном по-корректнее было
Код:
[Выделить все]
 
(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 каким-то образом у сплайна эти ручки находит, и по ним расширяет габариты?
__________________
Почему все вдруг становятся умными, когда уже не надо?

Последний раз редактировалось Disney, 22.10.2009 в 09:43.
Disney вне форума  
 
Непрочитано 22.10.2009, 08:35
#26
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от 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
Миниатюры
Нажмите на изображение для увеличения
Название: GetBox_spline.JPG
Просмотров: 140
Размер:	12.9 Кб
ID:	27616  
Do$ вне форума  
 
Непрочитано 22.10.2009, 08:59
#27
Disney

Геодезист
 
Регистрация: 12.03.2009
Сибирь (где медведи по улицам ходят)
Сообщений: 859
Отправить сообщение для Disney с помощью Skype™


Цитата:
Сообщение от Do$ Посмотреть сообщение
Не похоже
Похоже
зелёным - vla-GetBoundingBox для сплайна
красным - сплайн
синим - полилиния, сглаженная сплайном
с лева ручки включены у полилинии, с право у сплайна.
Ну, если честно, я в ручную подгонял, так чтоб и полилиния совпадала со сплайном, и чтоб ручки совпадали с габаритом.
Миниатюры
Нажмите на изображение для увеличения
Название: Сплайн.jpg
Просмотров: 136
Размер:	34.0 Кб
ID:	27617  
__________________
Почему все вдруг становятся умными, когда уже не надо?
Disney вне форума  
 
Автор темы   Непрочитано 22.10.2009, 09:29
#28
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


Ладно фиг с ним с сплайном, по поводу динамических блоков что-то намечается?
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 22.10.2009, 09:54
#29
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от 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 Посмотреть сообщение
по поводу динамических блоков что-то намечается?
По поводу динамических блоков с параметром видимости - вполне логично, что границы блока будут браться по наибольшему примитиву, даже если он не виден. Я так думаю, что самый простой вариант - взрывать блок, создавать из "осколков" новый и прогонять через программу.
Вложения
Тип файла: dwg
DWG 2004
spline_test.dwg (27.9 Кб, 1777 просмотров)
Do$ вне форума  
 
Непрочитано 22.10.2009, 10:35
#30
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,749


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

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.

Последний раз редактировалось Кулик Алексей aka kpblc, 22.10.2009 в 10:41.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 22.10.2009, 10:57
#31
Disney

Геодезист
 
Регистрация: 12.03.2009
Сибирь (где медведи по улицам ходят)
Сообщений: 859
Отправить сообщение для Disney с помощью Skype™


Да уж хитрый сплайн, попробовал его так
Код:
[Выделить все]
 
(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
Похоже, но не точно, габарит может быть, как чуть больше(что не страшно), так и чуть меньше(что не приятно ).
Цитата:
Как я понял, граница сплайна берется по контрольной точке (что за зверь такой? ), если угол между прямыми, проведенными в ближайшие контрольные точки тупой. А вот если острый - там какой-то другой алгоритм...
Ну, тут ты не совсем честен, ты зачем верхнюю вершину, полилинии построенной по контрольным точкам, к рамке подтянул?
__________________
Почему все вдруг становятся умными, когда уже не надо?
Disney вне форума  
 
Непрочитано 22.10.2009, 11:09
#32
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от Disney Посмотреть сообщение
Ну, тут ты не совсем честен, ты зачем верхнюю вершину, полилинии построенной по контрольным точкам, к рамке подтянул?
Гадом буду! Только цвет поменял и тип линии - остальное все само построилось
Коды выложил, чертеж есть - проверь!
Do$ вне форума  
 
Непрочитано 22.10.2009, 11:12
#33
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,749


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

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 22.10.2009, 11:22
#34
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Объектную привязку забыл снести
Виноват
Значит все не так просто, как я думал.
Do$ вне форума  
 
Непрочитано 22.10.2009, 11:58
#35
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,843


Да действительно со спалйном не лады у getbounbox'а - но intersectionwith работает правильно - если кому принципиально можно "намолевать" рекурсивный аналог getbounboxa с заданной точностью ну скажем до 0.000001 при помощи "золотого сечения" (для незнающих наберите в гуле "метод золотого сечения"). Самому совсем не как сейчас.
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Автор темы   Непрочитано 22.10.2009, 12:03
#36
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


так что насчет динблоков с параметром видимость
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 22.10.2009, 12:07
#37
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,749


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

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 22.10.2009, 12:27
#38
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Дай пример Вечером, если не забуду (и если до этого уже не будет решения) - попробую сделать.
держи
Temp.dwg
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 22.10.2009, 13:38
#39
LSN


 
Регистрация: 19.04.2007
Сообщений: 191


Или вот еще образец
Вложения
Тип файла: dwg
DWG 2004
Ramka.dwg (63.8 Кб, 1773 просмотров)
LSN вне форума  
 
Непрочитано 22.10.2009, 14:11
#40
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,749


Сделать корректно работающий код не получилось даже для тепличных условий. Явно где-то в логике ошибка
Для тех, кто захочет "добить до ума":
Код:
[Выделить все]
(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 хотя бы по одному из направлений.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 22.10.2009, 22:03
#41
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Нижнюю левую точку находит верно, с правой верхней неполадки... Покопаюсь.
Do$ вне форума  
 
Непрочитано 22.10.2009, 22:04
#42
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,749


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

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 22.10.2009, 22:07
#43
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Код:
[Выделить все]
(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 было
ПС: Работает изумительно!
Do$ вне форума  
 
Непрочитано 22.10.2009, 22:13
#44
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,749


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

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 23.10.2009, 09:46
#45
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


Просьба к зубрам а теперь можно оформить сие в рабочую программу, с учетом поста 1
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 23.10.2009, 12:57
#46
Сергей Богатов


 
Регистрация: 21.02.2009
Сообщений: 825


Offtop:
может понаделать листов и печатать из них?
__________________
Я-проектировщик бывший проектировщик!
Сергей Богатов вне форума  
 
Автор темы   Непрочитано 23.10.2009, 13:27
#47
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


Цитата:
Сообщение от Сергей Богатов Посмотреть сообщение
может понаделать листов и печатать из них?
Это не всегда оправдано, тут еще больше телодвижений чем при печати из модели
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 24.10.2009, 09:19
#48
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Здесь и здесь рассматривался метод бисекции. Так вот, этот метод вполне иожно применить для нахождения габаритного контейнера для сплайна (и не только) . Вот один из вариантов рекурсивного аналога 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
CB вне форума  
 
Непрочитано 24.10.2009, 14:47
#49
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Код:
[Выделить все]
Команда: 'VLIDE _rectang
Первый угол или [Фаска/Уровень/Сопряжение/Высота/Ширина]:
Выберите pline,spline,ellipse: Возникла серьезная ошибка ***
достигнут внутренний предел стека (смоделирован)"\n*** INTERNAL ERROR: VL 
namespace mismatch\n"" type Y to reset: "y
Не справилась
Вложения
Тип файла: dwg
DWG 2004
spline_test_CB.dwg (33.2 Кб, 1565 просмотров)
Do$ вне форума  
 
Непрочитано 25.10.2009, 11:03
#50
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Согласен, при достаточно большом количестве иттераций рекурсивной функции (в данном примере ф-ция 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
CB вне форума  
 
Непрочитано 26.10.2009, 10:18
#51
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от 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. Выложенный ранее код не прошел тестирования Исправил, работать стало помедленнее, но корректно.

Последний раз редактировалось Do$, 26.10.2009 в 14:50. Причина: Исключил Fitpoints из расчета - не обрисовывались некоторые сплайны.
Do$ вне форума  
 
Непрочитано 26.10.2009, 15:59
#52
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


>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
CB вне форума  
 
Непрочитано 26.10.2009, 16:22
#53
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от CB Посмотреть сообщение
>Do$
1. На сглаженной полилинии ф-я test выдает

Код:

Command: test
Select spline:; error: bad DXF group: (10 nil nil)
да ну ее, эту сглаженную на ней vla-getboundingbox и так корректно работает, поэтому функцию делал только для сплайна: в начале идет проверка, если выбранный объект не сплайн - выдает nil. Ну а вспомогательная программа отрисовки естессна ругается, что вместо координат nil получает.
Do$ вне форума  
 
Автор темы   Непрочитано 02.11.2009, 15:22
#54
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


А рабочая версия программы для распечатки по объекту уже есть или как?
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 02.11.2009, 17:12
#55
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Все наработки этой темы скидал в кучу, особо не проверял (Нужно заменить <Имя устройства вывода> на свой принтер, после загрузки запускать командой 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
Do$ вне форума  
 
Автор темы   Непрочитано 03.11.2009, 15:38
#56
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


Спасибо тебе добрый человек
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 06.11.2009, 12:36 мой код для печати по дин блокам
#57
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


Парни я честно говоря не вник о чём писали ранее, поэтому извените если повторился в чём то. Вот мой код для печати по динамическим блокам из 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)))))
Кстати она отличаеться тем что расставив блоки по всем чертежам можно не заморачиваясь выделить их все и распечатать, прога сама отыщет блоки.

Последний раз редактировалось Колька, 06.11.2009 в 14:45. Причина: переделал для российского пользователя
Колька вне форума  
 
Непрочитано 06.11.2009, 13:38
#58
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,749


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

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 06.11.2009, 13:45
#59
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


Колька код из поста 55 печатает по выбору объекта пример см пост 1. То бишь просто выбираешь объект, а прога определяет сама границы печати и отправляет на принтер. Все настройки делаются в самой программе, тама все понятно.
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 06.11.2009, 13:46
#60
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


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

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

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

Последний раз редактировалось Колька, 06.11.2009 в 13:51. Причина: прочитал дальше:)
Колька вне форума  
 
Непрочитано 06.11.2009, 22:50
#61
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от Колька Посмотреть сообщение
Это я понял, только ведь если много чертежей в моделе то придётся помучаться выбирая объекты, а здесь просто всё выделяем и чепятаем
Все равно надо сперва твои точки расставить по чертежу Кстати, точками не очень наглядно - не видно, что попало в границы печати, а что нет. Думаю, что лучше динамический блок делать в виде рамки.

Цитата:
Сообщение от Колька Посмотреть сообщение
Кто нибудь знает как вытащить имена принтеров в лиспе?
Код:
[Выделить все]
(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
Do$ вне форума  
 
Непрочитано 09.11.2009, 00:31
#62
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


Цитата:
Сообщение от Do$ Посмотреть сообщение
Все равно надо сперва твои точки расставить по чертежу Кстати, точками не очень наглядно - не видно, что попало в границы печати, а что нет. Думаю, что лучше динамический блок делать в виде рамки.
Я это делал чисто для себя и колег, был трабл с распечаткой чертежей, а они все в стандартных рамках. Точки был самый оптимальный для использования в коллективе вариант, и незаметно и полезно
Спасибо за код, завтра на работе попробую!
Колька вне форума  
 
Непрочитано 10.11.2009, 13:05
#63
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


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

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Мне будет интересно взглянуть, если в ней задаются настройки печати без командных методов.
Do$ вне форума  
 
Непрочитано 10.11.2009, 14:11
#65
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


Сначала нужно окошко создать.
Это файл 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 честно стащил с какого-то инет учебника

Последний раз редактировалось Колька, 12.11.2009 в 15:11. Причина: исправлен для др языков
Колька вне форума  
 
Непрочитано 12.11.2009, 11:33
#66
JokerrSergh


 
Регистрация: 01.10.2008
Сообщений: 136


Колька, в 2007 русском автокаде не работает твоя програмка.
пишет:
Команда: npr
; ошибка: завершить / выйти прервать
JokerrSergh вне форума  
 
Непрочитано 12.11.2009, 11:36
#67
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


ща проверю
Колька вне форума  
 
Непрочитано 12.11.2009, 11:41
#68
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,749


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

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 12.11.2009, 11:43
#69
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


да нет, всё проще, файл PrintW.pcl не подцепился. JokerrSergh вы проверяли путь к этому файлу?
Колька вне форума  
 
Непрочитано 12.11.2009, 11:44
#70
JokerrSergh


 
Регистрация: 01.10.2008
Сообщений: 136


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


 
Регистрация: 26.07.2009
Сообщений: 31


а в файле PrintW.pcl правельный код?
Колька вне форума  
 
Непрочитано 12.11.2009, 11:48
#72
JokerrSergh


 
Регистрация: 01.10.2008
Сообщений: 136


код тупо скопировал из поста 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
Может я путь не там прописал? Где в автокаде его надо прописывать?
JokerrSergh вне форума  
 
Непрочитано 12.11.2009, 11:50
#73
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,881


Цитата:
Сообщение от Колька Посмотреть сообщение
а в файле PrintW.pcl правельный код?
в файле PrintW.pcl не правильное расширение. Правильно - PrintW.dcl
Nike на форуме  
 
Непрочитано 12.11.2009, 11:52
#74
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


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


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

и кстати я подправил сам лисп добавил в него нижние слеши. JokerrSergh скопируй код ещё раз
Миниатюры
Нажмите на изображение для увеличения
Название: 111.jpg
Просмотров: 96
Размер:	80.5 Кб
ID:	28715  
Колька вне форума  
 
Непрочитано 12.11.2009, 11:56
#75
JokerrSergh


 
Регистрация: 01.10.2008
Сообщений: 136


Цитата:
Сообщение от 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.
JokerrSergh вне форума  
 
Непрочитано 12.11.2009, 11:57
#76
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


вот как раз из-за нижних слешев, щас всё исправленно
Колька вне форума  
 
Непрочитано 12.11.2009, 12:00
#77
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,881


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

Команда: npr
Неизвестная команда "UCS". Для вызова справки нажмите F1.
Неизвестная команда "WORLD". Для вызова справки нажмите F1.
Крыс же предупреждал:
Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
А чего там проверять? Я уже говорил, что в официальных локализация этот код работать не будет.
Nike на форуме  
 
Непрочитано 12.11.2009, 12:03
#78
JokerrSergh


 
Регистрация: 01.10.2008
Сообщений: 136


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


 
Регистрация: 26.07.2009
Сообщений: 31


нужно выбрать все листы которые хочешь распечатать(там предварительно должны стоять точки). только подожди, я щас на локализованной версии её домучаю, должно получится
Колька вне форума  
 
Непрочитано 12.11.2009, 12:06
#80
JokerrSergh


 
Регистрация: 01.10.2008
Сообщений: 136


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


 
Регистрация: 26.07.2009
Сообщений: 31


важно тока что бы точки выбрались, можно только секущей рамкой задеть. Теперь всё работает, проверенно!
Колька вне форума  
 
Непрочитано 12.11.2009, 12:21
#82
JokerrSergh


 
Регистрация: 01.10.2008
Сообщений: 136


не работает
Команда: 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.
JokerrSergh вне форума  
 
Непрочитано 12.11.2009, 12:28
#83
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


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

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

Последний раз редактировалось Колька, 12.11.2009 в 12:34.
Колька вне форума  
 
Непрочитано 12.11.2009, 12:38
#84
JokerrSergh


 
Регистрация: 01.10.2008
Сообщений: 136


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

Команда: 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

файлик прилагаю
Вложения
Тип файла: dwg
DWG 2007
NPr.dwg (95.7 Кб, 1101 просмотров)
JokerrSergh вне форума  
 
Непрочитано 12.11.2009, 12:49
#85
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


У меня распечаталась. Будем искать в чём косяк. набери в командной строке
Код:
[Выделить все]
(command "_plot" "_y" "")
и пришли результат
Колька вне форума  
 
Непрочитано 12.11.2009, 13:05
#86
JokerrSergh


 
Регистрация: 01.10.2008
Сообщений: 136


Команда: (command "_plot" "_y" "")
nil
Имя устройства вывода или [?] <Нет>:
JokerrSergh вне форума  
 
Непрочитано 12.11.2009, 13:18
#87
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


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

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

Последний раз редактировалось Колька, 12.11.2009 в 13:26.
Колька вне форума  
 
Непрочитано 12.11.2009, 13:36
#88
JokerrSergh


 
Регистрация: 01.10.2008
Сообщений: 136


Команда: (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 мм)"
JokerrSergh вне форума  
 
Непрочитано 12.11.2009, 13:43
#89
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


короче просто меняй строчку:
Код:
[Выделить все]
(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 мм)"))
и должно быть для твоего принтера всё ок.
а я пока поскриплю мозгами как вытащить список листов
Колька вне форума  
 
Непрочитано 12.11.2009, 13:49
#90
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от Колька Посмотреть сообщение
как вытащить список листов
У меня получилось только для текущего принтера/плоттера:
Код:
[Выделить все]
(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
Do$ вне форума  
 
Непрочитано 12.11.2009, 14:03
#91
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


пасиб Это не выход, но надеюсь направит в нужную сторону
Колька вне форума  
 
Непрочитано 12.11.2009, 14:08
#92
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


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


 
Регистрация: 26.07.2009
Сообщений: 31


вот как раз мне это и надо, я сделаю после выбора принтера его текущим и выдам список только для этого принтера
только надеюсь текущий это не тот который в винде по умалчанию, а то это неохото трогать
Колька вне форума  
 
Непрочитано 12.11.2009, 14:21
#94
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


По умолчанию стоит плоттер с оригинальным названием "None"(анг.версия) (если настройки печати не менялись в листе)
Do$ вне форума  
 
Непрочитано 12.11.2009, 14:31
#95
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


Do$ подскажи плиз глупому какой сиспеременной или командой можно сменить текущий плоттер
Колька вне форума  
 
Непрочитано 12.11.2009, 14:36
#96
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Код:
[Выделить все]
(vla-put-ConfigName
  (vla-get-ActiveLayout
    (vla-get-ActiveDocument (vlax-get-acad-object))
  ) ;_ end of vla-get-ActiveLayout
  "тут имя принтера/плоттера"
) ;_ end of vla-put-ConfigName

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

Последний раз редактировалось Do$, 12.11.2009 в 14:48.
Do$ вне форума  
 
Непрочитано 12.11.2009, 15:03
#97
JokerrSergh


 
Регистрация: 01.10.2008
Сообщений: 136


вот подгрузил людей
Забегу завтра, раб. день подошел к концу
JokerrSergh вне форума  
 
Непрочитано 12.11.2009, 15:15
#98
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


Всё супер коды вставил теперь при выборе бумаги выдаёться большущий правдивый список
я там свою прогу подправил теперь можно пользоваться.
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))
)

Последний раз редактировалось Колька, 12.11.2009 в 15:22.
Колька вне форума  
 
Непрочитано 12.11.2009, 15:26
#99
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от Колька Посмотреть сообщение
Do$ ты просто гений, я там пока в этих vla- в справке ковырялся чуть голову не сломал
Не гений, просто я уже вторую неделю сижу ковыряю vla на предмет печати, чтобы избавиться от коммандных методов.
Do$ вне форума  
 
Непрочитано 13.11.2009, 16:25
#100
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Колька, мне вот что интересно: а если твой блок "Ramka_dlya_pechati" стоит в нескольких листах чертежа, как будет происходить печать тех блоков, которые находятся не на текущем листе?
Do$ вне форума  
 
Непрочитано 13.11.2009, 22:04
#101
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


Цитата:
Сообщение от Do$ Посмотреть сообщение
Колька, мне вот что интересно: а если твой блок "Ramka_dlya_pechati" стоит в нескольких листах чертежа, как будет происходить печать тех блоков, которые находятся не на текущем листе?
хреново я об этом думал, тока пока не было повода дописать. у меня был код выделяющий все блоки с определённым именем на чертеже, можно её приделать сюда, потом, если понадобится.

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

Последний раз редактировалось Колька, 16.11.2009 в 06:55.
Колька вне форума  
 
Непрочитано 16.11.2009, 07:09
#102
JokerrSergh


 
Регистрация: 01.10.2008
Сообщений: 136


Колька, получилось запустить, все работает и печатает
Теперь вопросы:
1. После запуска проги нужно каждый раз устанавливать принтер и бумагу? Или можно сделать чтобы при первом запуске проги выбрал принтер, а при остальных запусках он уже был установлен.
2. Хотелось бы иметь возможность менять масштаб печати, ибо "вписать" не всегда устраивает.
В остальном меня все устраивает СПАСИБО разработчику и всем участникам
JokerrSergh вне форума  
 
Непрочитано 16.11.2009, 07:35
#103
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


Всю автоматичность можно задать в строчке (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))
можешь этот код на разные команды сделать и разные кнопочки присвоить
Колька вне форума  
 
Непрочитано 16.11.2009, 07:48
#104
JokerrSergh


 
Регистрация: 01.10.2008
Сообщений: 136


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

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

Последний раз редактировалось JokerrSergh, 16.11.2009 в 07:58.
JokerrSergh вне форума  
 
Непрочитано 18.11.2009, 04:35
#105
JokerrSergh


 
Регистрация: 01.10.2008
Сообщений: 136


и тишина
JokerrSergh вне форума  
 
Непрочитано 18.11.2009, 08:31
#106
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


пардон, у меня что то оповещение не дошло.
Цитата:
Сообщение от JokerrSergh Посмотреть сообщение
Было бы здорово чтобы прога умела сама определять нужный формат листа по соотношению сторон этого листа (при условии, что сам лист начерчен правильно: т.е. А4=210х297, или 2100х2970 и т.п.)
Я над этим думал, но проблема в том что листы не всегда в одном масштабе рисуют, в следствии чего по размеру лист не опознать, по пропорциям тоже не катит(они все одинаковые) единственное что приходит в голову сделать у моего блока атрибут и по нему проверять, что за лист. Короче надо думать чем жертвовать временем при распечатке или при расстановке блоков.
Колька вне форума  
 
Непрочитано 18.11.2009, 09:15
#107
JokerrSergh


 
Регистрация: 01.10.2008
Сообщений: 136


Цитата:
Сообщение от Колька Посмотреть сообщение
пардон, у меня что то оповещение не дошло.

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


 
Регистрация: 19.04.2007
Сообщений: 191


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

Цитата:
Сообщение от Колька Посмотреть сообщение
Короче надо думать чем жертвовать временем при распечатке или при расстановке блоков.
Лучше пожертвовать временем при расстановке блоков, т.к. их все равно нужно расставлять, а изменить атрибут можно сразу нескольким блокам.

Есть ли возможность определять формат по названию параметра видимости динамического блока? И возможно ли тогда будет в блок вставить рамку, или здесь и возникают ошибки о которых ты писал?
LSN вне форума  
 
Непрочитано 18.11.2009, 09:36
#109
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


Мысли хорошие, только мешает одна весч, у всех принтеров по разному называються форматы и что хуже того одни и те же форматы могут быть разные по размерам(оверсайс там и всё такое). Действительно унверсальную прогу можно сделать если только что то подготовительное делать что б адаптировать её для принтера Скорей всего придёться при самом первом запуске проги говорить ей какой формат с каким соотносится и в текстовый файлик это записать. Буду думать как это сделать.
Колька вне форума  
 
Непрочитано 18.11.2009, 11:00
#110
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Как альтернативу, выложу бета-версию программы, в которой я попытался по максимуму уйти от коммандных методов.
Печатает варианты:
  • выбранный объект
  • несколько выбранных объектов
  • все блоки с определенным именем на чертеже
Бета-версия, потому что есть мысли по усовершенствованию (если будет время и желание )
У программы есть особенности:
  • изменяются настройки печати для вкладки.
  • с динамическими блоками и мультитекстом могут быть неполадки
  • другие, пока не замеченные
Код:
[Выделить все]
(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
Do$ вне форума  
 
Непрочитано 18.11.2009, 11:37
#111
Колька


 
Регистрация: 26.07.2009
Сообщений: 31


Do$, професионально я и не подумал о том что можно .dcl автоматически создавать и отсортировывать форматы A... вобчем пошёл я совершенствоваться
Колька вне форума  
 
Непрочитано 18.11.2009, 11:57
#112
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от Колька Посмотреть сообщение
я и не подумал о том что можно .dcl автоматически создавать
Тоже об этом не помышлял, пока не заметил в pltools у VVA
Do$ вне форума  
 
Непрочитано 18.11.2009, 13:28
#113
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,749


Цитата:
Сообщение от JokerrSergh Посмотреть сообщение
и тишина
http://forum.dwg.ru/showthread.php?t=30619
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 23.11.2009, 11:25 Печать по объекту (продолжение закрытой темы)
#114
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


Поскольку предыдущая тема Печать из модели по выбору объекта, по вине несознательных товарищей была закрыта, а суть вопроса до конца не раскрыта, создаю новую тему.
Итак, с темой вопроса прошу ознакомится в приведенной выше ссылке, сегодня имеем программку товарища 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


Но лисп работает некорректно.
Печатает четвертями, а то и восьмушками, причем только правый нижний угол.
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:

Последний раз редактировалось Кулик Алексей aka kpblc, 23.11.2009 в 11:30.
zenon вне форума  
 
Непрочитано 23.11.2009, 11:29
#115
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 36,749


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

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 23.11.2009, 12:32
#116
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от zenon Посмотреть сообщение
Печатает четвертями, а то и восьмушками, причем только правый нижний угол.
Хоть один пример бы. (dwg, в формате acad2004)
Do$ вне форума  
 
Автор темы   Непрочитано 23.11.2009, 12:49
#117
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


Цитата:
Сообщение от Do$ Посмотреть сообщение
Хоть один пример бы. (dwg, в формате acad2004)
например вот
сам файл
Пример.dwg
выбор по блоку
Нажмите на изображение для увеличения
Название: Vibor_pechat.JPG
Просмотров: 164
Размер:	18.3 Кб
ID:	29429
и собсно результат
Результат.pdf
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 23.11.2009, 12:58
#118
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Это то, о чем писал Алексей:
Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Из обработки напрочь исключаются атрибуты; не учитывается поворот и немировая система координат; не рассматривается вопрос масштаба, не равного 1.0 хотя бы по одному из направлений.
В приложенном чертеже блоки растянуты, а печатает, как будто масштаб блока 1:1.
Do$ вне форума  
 
Автор темы   Непрочитано 23.11.2009, 13:41
#119
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


Do$, то-исть это не лечится??
ps эх а шастье было так близко
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 23.11.2009, 14:06
2 | #120
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Лечится, только сразу не смогу сказать как. Подумать надо.
Обновление:
Вопрос масштаба решил. Поворот и атрибуты пока не трогал (может и не буду). По идее, с немировой системой координат тоже проблем не должно быть.
Код:
[Выделить все]
(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$, 23.11.2009 в 15:37.
Do$ вне форума  
 
Автор темы   Непрочитано 26.11.2009, 10:25
#121
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


Do$, прожка нормально работает, как и упоминал поворот блока и атрибуты не обрабатываются.
ps А вот поворот Мтекста отлично обрабатывается.
pss а можно запрос при выборе
Цитата:
Укажите объект для печати, или:[Несколько/ Блок]
повесить на правую кнопку мыши?
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 26.11.2009, 20:46
#122
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от zenon Посмотреть сообщение
ps А вот поворот Мтекста отлично обрабатывается.
Я думаю, что если глубже копнуть, то с мтекстом будут нелады. Например, если междустрочный интервал увеличить...
Не совсем понял насчет правой кнопки мыши. Сделать контекстное меню при нажатии ПКМ из пунктов "Несколько" и "Блок"? А не проще дин. ввод включить?
Do$ вне форума  
 
Автор темы   Непрочитано 27.11.2009, 09:48
#123
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,399
<phrase 1=


Цитата:
Сообщение от Do$ Посмотреть сообщение
А не проще дин. ввод включить?
три движения лишних
переключить язык
ввести букву
нажать ентер
да и привык уже к ПКМ,автоматом жму. ан нет
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 27.11.2009, 10:16
#124
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


При дин. вводе можно пункты выбирать мышкой (см. рис.).
Если динамический ввод принципиально не нравится - тогда не обязательно язык переключать, команды дублируются на английском:
"Несколько": _m (_Multy)
"Блок": _b (_Block)
"Имя": _n (_Name)
Как контекстное меню на ПКМ повесить пока не представляю. Предполагаю, что нужно делать реактор на это событие, а дальше - .
Если б был какой-то пример программы на LISP с обработкой нажатия ПКМ и выводом контекстного меню...
А попроще - может написать макрокоманду и повесить на кнопку?
Миниатюры
Нажмите на изображение для увеличения
Название: ep_di.JPG
Просмотров: 145
Размер:	6.0 Кб
ID:	29667  
Do$ вне форума  
 
Непрочитано 11.02.2010, 11:29
#125
Djur


 
Регистрация: 07.06.2008
ЗвезДонецк
Сообщений: 131


Круто!!! Очень Благодарен, за кучу сэкономленного времени)))))))))
А можно, пожалуйста, получить последние изменения, там где с дин. вводом? ))
Djur вне форума  
 
Непрочитано 12.02.2010, 09:03
#126
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


В сообщении #120 последняя на данный момент версия!
Динамический ввод - это не "фишка" программы, это режим самого автокада (включается и выключается нажатием F12)
Do$ вне форума  
 
Непрочитано 04.03.2010, 11:48
#127
Nikolay 2


 
Регистрация: 27.02.2008
Сообщений: 139


Цитата:
Сообщение от JokerrSergh Посмотреть сообщение
Можно ли как-нибудь одновременно (при одном запуске проги) печатать несколько форматов листов (например А3 и А4)?
Т.е. запускаешь прогу и выделяешь лист формата А3 и лист формата А4, и прога печатает лист А3 и лист А4.
Было бы здорово чтобы прога умела сама определять нужный формат листа по соотношению сторон этого листа (при условии, что сам лист начерчен правильно: т.е. А4=210х297, или 2100х2970 и т.п.)
Это действительно было бы то, что "врач прописал". Do$, такое возможно сделать, а то печатать приходится из файла где куча форматов от А4 до А1. Хотя, даже то что уже есть, значительно облегчает процесс печати, и за это спасибо.
Nikolay 2 вне форума  
 
Непрочитано 04.03.2010, 11:55
#128
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Пожалуйста!
Будет время - поколдую. Пока недосуг.
Do$ вне форума  
 
Непрочитано 10.03.2010, 16:11
#129
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Опишу как я себе это представляю:
Получается, что программа должна сама определять мало того, что формат листа, так еще и принтер, куда нужно печатать. Ведь вряд ли кто-то печатает А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
Do$ вне форума  
 
Непрочитано 11.03.2010, 14:25
#130
Nikolay 2


 
Регистрация: 27.02.2008
Сообщений: 139


Цитата:
Сообщение от Do$ Посмотреть сообщение
То есть надо будет сделать предварительную настройку: для каждого формата задать принтер/плоттер, формат/размер листа в форме диалога.
В принципе об этом шла речь... Типа, выбираем чертежи формата А4 и устанавливаем для них принтер ХХ, затем выбираем чертежи формата А3 и для них назначаем принтер ХХ и т.д.
Nikolay 2 вне форума  
 
Непрочитано 12.03.2010, 15:43
#131
ssn

Инженер проектировщик (раздел ТМ - фриланс)
 
Регистрация: 06.12.2003
Воронеж
Сообщений: 1,215
Отправить сообщение для ssn с помощью Skype™


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


 
Регистрация: 27.02.2008
Сообщений: 139


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

Последний раз редактировалось Nikolay 2, 15.03.2010 в 13:09.
Nikolay 2 вне форума  
 
Непрочитано 15.03.2010, 20:49
#133
ssn

Инженер проектировщик (раздел ТМ - фриланс)
 
Регистрация: 06.12.2003
Воронеж
Сообщений: 1,215
Отправить сообщение для ssn с помощью Skype™


http://forum.abok.ru/index.php?showtopic=28075
в последнем посте есть немного видео по макросу
ssn вне форума  
 
Непрочитано 16.03.2010, 08:00
#134
Nikolay 2


 
Регистрация: 27.02.2008
Сообщений: 139


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

Инженер проектировщик (раздел ТМ - фриланс)
 
Регистрация: 06.12.2003
Воронеж
Сообщений: 1,215
Отправить сообщение для ssn с помощью Skype™


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

Последний раз редактировалось ssn, 16.03.2010 в 17:41.
ssn вне форума  
 
Непрочитано 06.05.2010, 10:14
#136
JokerrSergh


 
Регистрация: 01.10.2008
Сообщений: 136


Цитата:
Сообщение от 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
Вопрос от чайника: Как изменить масштаб печати? По умолчанию в лиспе стоит "вписать", а мне нужно чтобы можно было установить другой масштаб. Как это сделать? Где и что поменять в лиспе?
JokerrSergh вне форума  
 
Непрочитано 06.05.2010, 10:40
#137
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Собсна, идея программы тогда теряется... Но если надо, то меняй строчки:
Код:
[Выделить все]
(cons "UseStandardScale" :vlax-true)
(cons "StandardScale" acVpScaleToFit)
на что-то другое.
Кстати, раз уж тему подняли...
У программы обнаружился баг, по крайней мере у меня возникает:
Если печатать из файла, с которого еще не проводилась печать стандартными средствами, то иногда листы печатаются с серой надписью [none] по диагонали. Достаточно один раз использовать команду PLOT, после этого печатается без лишних надписей. Может кто подскажет, в чем может быть дело?

Последний раз редактировалось Do$, 06.05.2010 в 11:02.
Do$ вне форума  
 
Непрочитано 06.05.2010, 11:25
#138
JokerrSergh


 
Регистрация: 01.10.2008
Сообщений: 136


Цитата:
Сообщение от Do$ Посмотреть сообщение
Собсна, идея программы тогда теряется... Но если надо, то меняй строчки:
Код:
[Выделить все]
(cons "UseStandardScale" :vlax-true)
(cons "StandardScale" acVpScaleToFit)
на что-то другое.
на что другое? Если мне нужно чтобы 1мм = 1.02 ед. чертежа
на что мне поменять эти строчки? Это фиксированный масштаб, которым я обычно печатаю
JokerrSergh вне форума  
 
Непрочитано 06.05.2010, 12:15
#139
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от 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)
Сохраняем изменения, и пробуем

Последний раз редактировалось Do$, 06.05.2010 в 12:29.
Do$ вне форума  
 
Непрочитано 07.05.2010, 05:49
#140
JokerrSergh


 
Регистрация: 01.10.2008
Сообщений: 136


DO$
вот теперь то, что нужно, всё работает
пока багов не замечал, даже при первом распечатывании твоим лиспом всё ништятски печатается.
Спасибо огромное!!!
JokerrSergh вне форума  
 
Непрочитано 07.05.2010, 08:22
#141
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Ну и славненько На здоровье!
Цитата:
Сообщение от JokerrSergh Посмотреть сообщение
пока багов не замечал, даже при первом распечатывании твоим лиспом всё ништятски печатается.
Может быть у меня с автокадом что-то
Do$ вне форума  
 
Непрочитано 27.04.2011, 11:03
#142
JokerrSergh


 
Регистрация: 01.10.2008
Сообщений: 136


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

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

Просьба объяснить подробно для чайника, не ориентирующегося в тексте лиспа.
Лисп прилагается (там установлен масштаб печати 1:1.02 согласно инструкции из поста #139)
Вложения
Тип файла: lsp Easyplot.lsp (21.5 Кб, 130 просмотров)
__________________
Вагоны, они ведь умнее паровоза, потому что они его толкают... когда он тормозит
JokerrSergh вне форума  
 
Непрочитано 27.04.2011, 12:36
#143
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


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


 
Регистрация: 01.10.2008
Сообщений: 136


Цитата:
Сообщение от 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 перед использованием лиспа тоже не помогает.
Помогает лишь копирование всех листов из этого файла в новый девственно чистый файл.
Вложения
Тип файла: rar Голяк.rar (80.0 Кб, 82 просмотров)
__________________
Вагоны, они ведь умнее паровоза, потому что они его толкают... когда он тормозит

Последний раз редактировалось JokerrSergh, 28.04.2011 в 10:41.
JokerrSergh вне форума  
 
Непрочитано 29.04.2011, 10:55
#145
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


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


 
Регистрация: 01.10.2008
Сообщений: 136


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

Последний раз редактировалось JokerrSergh, 29.04.2011 в 12:02.
JokerrSergh вне форума  
 
Непрочитано 03.10.2011, 12:57
#147
RiderPSV


 
Регистрация: 13.11.2010
Сообщений: 2


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

Пробуйте и совершенствуйте свою программу. Я начал ее использовать=)
Вам всем спасибо!
RiderPSV вне форума  
 
Непрочитано 03.10.2011, 15:02
#148
Pastor

это только кличка
 
Регистрация: 22.10.2006
Москва
Сообщений: 252


Цитата:
Ребята, не поверите...
Не поверим! Быть такого не может
__________________
...в шее моей жилы железные, и лоб мой - медный...
Pastor вне форума  
 
Непрочитано 03.10.2011, 15:30
#149
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от RiderPSV Посмотреть сообщение
Заменить строку:
"\nУкажите объект для печати, или:[Несколько/ Блок]"
на строку:
"\nУкажите объект для печати, или [Несколько/Блок]:"
У меня оба варианта одинаково работают в AutoCAD 2010. Может быть в более ранних версиях есть разница.
Кажется понял о чем речь - имеется в виду контекстное меню по ПКМ. Действительно, с исходной строкой его нет, с исправленной - есть.
RiderPSV,
Do$ вне форума  
 
Непрочитано 03.10.2011, 18:42
#150
RiderPSV


 
Регистрация: 13.11.2010
Сообщений: 2


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


 
Регистрация: 11.10.2010
Сообщений: 979


Цитата:
Сообщение от RiderPSV Посмотреть сообщение
хотел скачать текст скрипта из сообщения #120, но так его там и не нашел.
Включи скрипты в браузере, перезагрузи страницу и нажми на "+" в #120.
__________________
(/= RegDate StartReadDate)
Лиспер вне форума  
 
Непрочитано 05.10.2011, 09:40
#152
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от RiderPSV Посмотреть сообщение
И еще заметил проблему (по-моему): Программа отображает список принтеров, НО(!) она не показывает в этом списке принтеры с расширением *.pc3
Так специально сделано в программе, потому что были сложности с pc3 конфигурациями. Печать осуществляется командным методом и альтернативы этому нет, а некоторые pc3 плоттеры имеют отличный от стандартного набор команд для печати. Поэтому не стал разбираться с каждым индивидуально, а просто их отфильтровал.
Do$ вне форума  
 
Непрочитано 07.10.2011, 13:42
#153
adu

инженер систем безопасности
 
Регистрация: 07.10.2011
Сообщений: 36
<phrase 1=


День добрый! Спасибо огромное Вам за программу, очень нужная штука, и работает прекрасно. Только можно было бы включить в диалог с параметрами печати поле для ввода количества копий для распечатки? Очень облегчило бы работу.
adu вне форума  
 
Непрочитано 14.09.2012, 09:08
#154
gest

GEODATA Engineering S.p.A.
 
Регистрация: 11.02.2005
Монино
Сообщений: 668


Do$ возможно продолжить развитие программы, несколько мелких плюшек здорово облегчит жизнь.
- добавление принтера по умолчанию;
- количество копий.
gest на форуме  
 
Непрочитано 14.09.2012, 10:59
#155
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Чесслово, устал я уже открещиваться от этой программы
Дело в том, что ни я, ни мои коллеги ею не пользуемся. Поэтому, учитывая, что времени катострофически ни на что не хватает , сейчас занимаюсь только первостепенными задачами. Если вдруг сложатся воедино факторы: свободное время, доступность компьютера с автокадом и филантропическое настроение, то я могу поковырять программу и внести в нее те изменения, которых вы желаете. Но вероятность этого в ближайшее время очень мала .
Если вдруг кто другой захочет в ней поковыряться - я обеими руками за, при необходимости могу разъяснить что к чему в ней.
Прошу понять и простить
Do$ вне форума  
 
Непрочитано 03.10.2012, 17:12
#156
Fazeroid


 
Регистрация: 03.10.2012
Сообщений: 6


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

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от Fazeroid Посмотреть сообщение
Может, кто подскажет можно ли посредствам Autolisp (автоматически) назначить имя файла (в окне сохранения PDF) при выводе на печать через PDF из пространства модели или листа.
Начинаем гадать:
Печать выполняется командными методами?
Скорее всего да.
Команда печати _.-PLOT?
Наверное так.
Тогда не понятно в чем проблема, имя файла указывается на соответствующий запрос и все.
Do$ вне форума  
 
Непрочитано 04.10.2012, 08:48
#158
Fazeroid


 
Регистрация: 03.10.2012
Сообщений: 6


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

После этого он выдает окно сохранения файла.
Печать идет через команду _.plot.
И еще в дополнение, как назначить путь сохранения посредством Autolisp?
Fazeroid вне форума  
 
Непрочитано 04.10.2012, 09:50
#159
bargool


 
Регистрация: 16.08.2006
Санкт-Петербург
Сообщений: 501
<phrase 1=


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

Последний раз редактировалось bargool, 04.10.2012 в 09:56.
bargool вне форума  
 
Непрочитано 04.10.2012, 10:01
#160
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,843


Цитата:
Сообщение от bargool Посмотреть сообщение
выставь filedia в 0
Offtop: Мы его поймали
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 04.10.2012, 10:05
#161
bargool


 
Регистрация: 16.08.2006
Санкт-Петербург
Сообщений: 501
<phrase 1=


Offtop: Я не виноват! Это всё он!!
bargool вне форума  
 
Непрочитано 04.10.2012, 10:37
#162
Fazeroid


 
Регистрация: 03.10.2012
Сообщений: 6


Печатаю я через стандартный принтер Adobe PDF, это он изначально предлагает Adobe PDF.pc3.
Даже изменение системной переменной filedia в 0 не дает никакого результата. Как появлялось окно с запросом так и появляется.
Может имя файла сохраняемого документа в PDF прописывается в кокой-нибудь системной переменной?
Хотя просмотрев список переменных я не нашел ничего похожего.
Fazeroid вне форума  
 
Непрочитано 04.10.2012, 10:41
1 | #163
bargool


 
Регистрация: 16.08.2006
Санкт-Петербург
Сообщений: 501
<phrase 1=


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


 
Регистрация: 03.10.2012
Сообщений: 6


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

P.S. Работу в пространстве листа с одним листом рассматривали не однократно и отметали как неудобную в нашем случае. Все благодаря полям, которые мы широко используем в своих проектах. А они не работают между пространствами Модель-Лист или Лист-Лист.
Fazeroid вне форума  
 
Непрочитано 04.10.2012, 13:21
#165
maratovich


 
Регистрация: 12.07.2009
г. Самара
Сообщений: 2,345
Отправить сообщение для maratovich с помощью Skype™


Цитата:
Сообщение от Fazeroid Посмотреть сообщение
Так вот при распечатке в PDF для каждого листа выскакивает окно сохранения файла.
Приложите пример этих рамок.
maratovich вне форума  
 
Непрочитано 06.10.2012, 00:40
1 | #166
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


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

Цитата:
Сообщение от Fazeroid Посмотреть сообщение
Вариант DWG to PDF.pc3 в моем случае не подходит...
Так и осталось загадкой, чем не устраивает DWGtoPDF.
Do$ вне форума  
 
Непрочитано 06.12.2012, 17:27
#167
Иван Павлов


 
Регистрация: 14.11.2012
Сообщений: 13


Интересно, а процесс отправки листа на печать у всех такой длительный (по лиспу #120),
кажется когда сам отправляешь он реально быстрее завершает отправку.
Иван Павлов вне форума  
 
Непрочитано 07.12.2012, 09:17
#168
Fazeroid


 
Регистрация: 03.10.2012
Сообщений: 6


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

Возникла еще такая проблема.
Сделал рамки листов динамическими, но проблема программы с определением координат рамки выделения листа при печати через команду "vla-getboundingbox". Эта функция каждый раз задает размеры наибольшего из листов в динамическом блоке. Как с этим бороться подскажите кто-нибудь пожалуйста.
Fazeroid вне форума  
 
Непрочитано 07.12.2012, 10:05
#169
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


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


 
Регистрация: 03.10.2012
Сообщений: 6


Цитата:
Сообщение от Do$ Посмотреть сообщение
Посмотри код из #120, там есть функция по определению границ динамического блока, которую написал Кулик Алексей. Суть в том, что проверяются все объекты внутри блока на предмет видимости и граница определяется только по видимым объектам. У vla-getboundingbox есть еще другие проблемы - со сплайнами, с мультитекстом...
Спасибо, посмотрю.
Fazeroid вне форума  
 
Непрочитано 07.12.2012, 11:19
#171
MEsher


 
Регистрация: 17.09.2012
Сообщений: 9


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

Каким-нибудь параметром можно отключить открытие созданного файла в pdf, то есть возможность тихой печати.
__________________
Код порою получается жутковат, конешно, и убиться об его можно, да ведь все под богом ходим...
MEsher вне форума  
 
Непрочитано 07.12.2012, 11:24
#172
bargool


 
Регистрация: 16.08.2006
Санкт-Петербург
Сообщений: 501
<phrase 1=


Цитата:
Сообщение от MEsher Посмотреть сообщение
Каким-нибудь параметром можно отключить открытие созданного файла в pdf, то есть возможность тихой печати.
только ручным снятием галочки в настройках DWG to PDF.pc3
__________________
Алексей
bargool вне форума  
 
Непрочитано 07.12.2012, 11:39
#173
MEsher


 
Регистрация: 17.09.2012
Сообщений: 9


Цитата:
Сообщение от bargool Посмотреть сообщение
только ручным снятием галочки в настройках DWG to PDF.pc3
А ведь достаточно было залезть в "Дополнительные свойства". Спасибо, помогло.
__________________
Код порою получается жутковат, конешно, и убиться об его можно, да ведь все под богом ходим...
MEsher вне форума  
 
Непрочитано 27.05.2013, 15:41
#174
RedAlex


 
Регистрация: 17.06.2009
Сообщений: 31


;Код из №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 печатаем или нет, все просто оказалось.
)

Последний раз редактировалось RedAlex, 27.05.2013 в 16:16.
RedAlex вне форума  
 
Непрочитано 12.03.2017, 15:05 Как сделать эту программу для множества рамок созданных динамическим блоком?
#175
Александр Лактионов


 
Регистрация: 12.03.2017
Сообщений: 3


это только для одного объекта, как сделать для множества рамок?
Александр Лактионов вне форума  
 
Непрочитано 12.03.2017, 15:07
#176
maratovich


 
Регистрация: 12.07.2009
г. Самара
Сообщений: 2,345
Отправить сообщение для maratovich с помощью Skype™


Цитата:
Сообщение от Александр Лактионов Посмотреть сообщение
это только для одного объекта, как сделать для множества рамок?
Вам сюда.
__________________
Вопрос : Где находится Тургай ? Ответ : Между Парагваем и Уругваем.....
maratovich вне форума  
 
Непрочитано 12.03.2017, 15:12 Что нужно добавить ,чтобы программа печатала множество рамок(форматов) во всем чертеже?
#177
Александр Лактионов


 
Регистрация: 12.03.2017
Сообщений: 3


К примеру 100 динамических блоков , формата А3 и чтобы за один раз сразу все распечатались ?
Александр Лактионов вне форума  
 
Непрочитано 12.03.2017, 15:14
#178
maratovich


 
Регистрация: 12.07.2009
г. Самара
Сообщений: 2,345
Отправить сообщение для maratovich с помощью Skype™


Цитата:
Сообщение от Александр Лактионов Посмотреть сообщение
К примеру 100 динамических блоков , формата А3 и чтобы за один раз сразу все распечатались ?
Пример приложите.
__________________
Вопрос : Где находится Тургай ? Ответ : Между Парагваем и Уругваем.....
maratovich вне форума  
 
Непрочитано 12.03.2017, 16:20 Пример
#179
Александр Лактионов


 
Регистрация: 12.03.2017
Сообщений: 3


Цитата:
Сообщение от maratovich Посмотреть сообщение
Пример приложите.
8 рамок ,чтобы все за раз распечатались
Я понимаю, что надо создать цикл(i+1) и список всех координат max min
Вложения
Тип файла: dwg
DWG 2007
примерdwg.dwg (608.8 Кб, 14 просмотров)
Александр Лактионов вне форума  
 
Непрочитано 12.03.2017, 18:22
#180
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 6,990


Поиском не пользуемся? - целая же тема про пакетную распечатку из модели есть.
Сергей812 вне форума  
 
Непрочитано 22.03.2017, 14:51
#181
valerik88


 
Регистрация: 02.07.2016
Сообщений: 195


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

В идеале бы научиться получать все те параметры, которые в окне печати установлены в данном чертеже и вставлять их в программе в команду _plot
valerik88 вне форума  
 
Непрочитано 22.03.2017, 15:30
#182
ытя


 
Регистрация: 23.09.2005
СПб
Сообщений: 418


Цитата:
Сообщение от valerik88 Посмотреть сообщение
А я не могу понять как получить текущий принтер?
Список доступных .pc3
(vl-directory-files (strcat(getvar "ROAMABLEROOTPREFIX")"Plotters\\")"*.pc3")
ытя вне форума  
 
Непрочитано 22.03.2017, 18:45
1 | #183
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


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

В идеале бы научиться получать все те параметры, которые в окне печати установлены в данном чертеже и вставлять их в программе в команду _plot
Тут же в теме ранее есть код, в котором это уже сделано: http://forum.dwg.ru/showpost.php?p=480876&postcount=120
Можно изменить его под свои нужды или просто использовать как шпаргалку.
__________________
Толковый выбор приходит с опытом, а к нему приводит выбор бестолковый. (The Mechanic)
Do$ вне форума  
 
Непрочитано 23.03.2017, 07:46
#184
valerik88


 
Регистрация: 02.07.2016
Сообщений: 195


Цитата:
Сообщение от Do$ Посмотреть сообщение
Тут же в теме ранее есть код, в котором это уже сделано: http://forum.dwg.ru/showpost.php?p=480876&postcount=120
Можно изменить его под свои нужды или просто использовать как шпаргалку.
Немного не то, но для моих нужд подойдёт.
valerik88 вне форума  
 
Непрочитано 27.03.2017, 12:44
#185
valerik88


 
Регистрация: 02.07.2016
Сообщений: 195


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

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

Прикладываю лисп и свой блок рамки.
Тестировалось на Autocad 2016
Вложения
Тип файла: dwg
DWG 2013
рамка.dwg (116.1 Кб, 17 просмотров)
Тип файла: lsp printAll.lsp (9.6 Кб, 21 просмотров)
valerik88 вне форума  
 
Непрочитано 27.03.2017, 12:52
1 | #186
baksconstructor


 
Регистрация: 05.11.2014
Сообщений: 929


Цитата:
Сообщение от valerik88 Посмотреть сообщение
Программка удобная, но работает только с моим блоком рамки (берёт из него формат - аттрибут FORMAT и размеры листа - атрибуты W и H, без всяких GetBoundingBox)
Ну что сказать.... Реверс рамки переварил нормально.
НО см. :
ГОСТ Р 21.1101-2013
Приложение Ж (обязательное). Основные надписи и дополнительные графы к ним

а именно размер и расположение графы "Согласовано"
baksconstructor вне форума  
 
Непрочитано 27.03.2017, 13:10
#187
valerik88


 
Регистрация: 02.07.2016
Сообщений: 195


Цитата:
Сообщение от baksconstructor Посмотреть сообщение
НО см. :
ГОСТ Р 21.1101-2013
Приложение Ж (обязательное). Основные надписи и дополнительные графы к ним
а именно размер и расположение графы "Согласовано"
Действительно. Поправил блок.
Вложения
Тип файла: dwg
DWG 2013
рамка.dwg (103.8 Кб, 22 просмотров)
valerik88 вне форума  
 
Непрочитано 01.05.2017, 15:53
#188
pant-79


 
Регистрация: 27.07.2013
Сообщений: 7
Отправить сообщение для pant-79 с помощью Skype™


Подниму тему, потому что более релевантной моим запросам темы поиск не выдал.
Задача печати плоских объектов из пространства модели передо мной не стоит, пользуюсь листами и вьюпортами и горя не знаю.
Но сейчас встала проблема автоматизации при создании таблиц-спецификаций с эскизами деталей в ячейках. Вручную при этом используется "плоский снимок", но у него есть куча недостатков:
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. Задача предполагает обращение к файловой системе (причем, дважды). Есть уже готовые решения для этого дела на лиспе?
pant-79 вне форума  
 
Непрочитано 01.05.2017, 16:07
#189
maratovich


 
Регистрация: 12.07.2009
г. Самара
Сообщений: 2,345
Отправить сообщение для maratovich с помощью Skype™


Цитата:
Сообщение от pant-79 Посмотреть сообщение
таблиц-спецификаций с эскизами деталей в ячейках
Чё ? Это по какому такому нормативу ?
Цитата:
Сообщение от pant-79 Посмотреть сообщение
но потом при переоткрытии файла параметр "вписывание блока" ломается и таблицу разносит, как Халка при трансформации.
Установите сервис пак, у Вас Автокад глючит, работаю с этим свойством 2009-2015 везде всё в норме.
Отсюда остальное описанное не требуется.
Цитата:
Сообщение от pant-79 Посмотреть сообщение
Есть уже готовые решения для этого дела на лиспе?
Скорее это уже в Поиск исполнителей, с полным ТЗ и примером конечного результата.
Я конечно отдалённо понял чего требуется и сделать можно, но сложно, это серьёзный проект получится.
__________________
Вопрос : Где находится Тургай ? Ответ : Между Парагваем и Уругваем.....
maratovich вне форума  
 
Непрочитано 01.05.2017, 16:12
#190
pant-79


 
Регистрация: 27.07.2013
Сообщений: 7
Отправить сообщение для pant-79 с помощью Skype™


Цитата:
Сообщение от maratovich Посмотреть сообщение
Установите сервис пак, у Вас Автокад глючит, работаю с этим свойством 2009-2015 везде всё в норме.
Отсюда остальное описанное не требуется.
То бишь, вы прочитали первый пункт недостатков, а остальные два проигнорировали. Если уж на то пошло, главный недостаток - второй.

Нет, исполнителей я не ищу. Я сам это все скомпоную в рабочую версию. Просто, если люди в теме и более информированы, чем я, то могут подсказать, куда копать насчет последних трех пунктов.
pant-79 вне форума  
 
Непрочитано 01.05.2017, 21:20
#191
maratovich


 
Регистрация: 12.07.2009
г. Самара
Сообщений: 2,345
Отправить сообщение для maratovich с помощью Skype™


Цитата:
Сообщение от pant-79 Посмотреть сообщение
То бишь, вы прочитали первый пункт недостатков, а остальные два проигнорировали. Если уж на то пошло, главный недостаток - второй.
Я всё полностью прочитал, собственно поэтому повторюсь:
1. Выяснить причину глюков со сбросом размеров блоков в таблице. И тогда
Цитата:
Если уж на то пошло, главный недостаток - второй.
отпадает, и недостаток превращается в достоинство.
2. Про
Цитата:
1. Снимок получается 1:1 (если с исправлением автокада)
2. Снимок никаким образом нельзя автоматизировать.
3. Снимок не отображает данные о цвете и вообще неспособен выдать никаких стилей отображения кроме каркаса.
оно так и должно работать т.к. плоский снимок это не команда автокада, а лисп, и автоматизировать его из вне не получится.

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

И ещё, я не зря писал
Цитата:
Сообщение от maratovich Посмотреть сообщение
Я конечно отдалённо понял чего требуется и сделать можно, но сложно, это серьёзный проект получится.
как надоест грабли ломать - пишите, задача решается в обход стандарта и на другом языке программирования.
__________________
Вопрос : Где находится Тургай ? Ответ : Между Парагваем и Уругваем.....
maratovich вне форума  
 
Непрочитано 02.05.2017, 11:35
#192
pant-79


 
Регистрация: 27.07.2013
Сообщений: 7
Отправить сообщение для pant-79 с помощью Skype™


Цитата:
Сообщение от maratovich Посмотреть сообщение
отпадает, и недостаток превращается в достоинство.
Цитата:
Сообщение от maratovich Посмотреть сообщение
оно так и должно работать т.к. плоский снимок это не команда автокада, а лисп, и автоматизировать его из вне не получится.
Пока что, сложив А и Б, из ваших слов выходит, что на команду "плоский снимок" есть открытый код на лиспе?

Последний раз редактировалось pant-79, 02.05.2017 в 13:41.
pant-79 вне форума  
 
Непрочитано 04.05.2017, 09:41
#193
pant-79


 
Регистрация: 27.07.2013
Сообщений: 7
Отправить сообщение для pant-79 с помощью Skype™


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

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Опять про печать из модели нескольких листов 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