dwg.ru forum rss xml
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму |

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

LISP. Построение габаритного контура для нескольких объектов с заданием поворота этого контура.

Версия для печати
 
Ответ
Опции темы Поиск в этой теме
Непрочитано 26.01.2017, 10:52 #1
LISP. Построение габаритного контура для нескольких объектов с заданием поворота этого контура.
Profan
 
Чужой
 
Москва
Регистрация: 25.12.2005
Сообщений: 13,504

Profan вне форума Вставить имя

Текст программы:
Код:
[Выделить все]
;;; Построение габаритного контура нескольких объектов под заданным углом
;;; Используются функции от Lee Mac http://www.lee-mac.com/ssboundingbox.html
;;; и Дима_ http://forum.dwg.ru/showthread.php?t=14437
;;; ГНОБ - Габарит Нескольких ОБъектов
(defun C:ГНОБ ( / echo sel idx obj ls1 ls2 ptrot ugol rbl gpt1 gpt2) 
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq sel (ssget))
;;; Функции от Lee Mac
(repeat (setq idx (sslength sel))
        (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
        (if (and (vlax-method-applicable-p obj 'getboundingbox)
                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
            )
            (setq ls1 (mapcar 'min (vlax-safearray->list llp) (cond (ls1) ((vlax-safearray->list llp))))
                  ls2 (mapcar 'max (vlax-safearray->list urp) (cond (ls2) ((vlax-safearray->list urp))))
            )
        )
)
;;;
(setq ptrot (list (/ (+ (nth 0 ls2) (nth 0 ls1)) 2) (/ (+ (nth 1 ls2) (nth 1 ls1)) 2)))
(vl-cmdf "_-BLOCK" "BBOX" ptrot sel "")
(vl-cmdf "_-INSERT" "BBOX" ptrot "1" "1" "0")
(initget 1)
(setq ugol (getreal "\nУгол поворота: "))
(vl-cmdf "_ROTATE" "_L" "" ptrot ugol)
(setq rbl (entlast))
;;; Функции от Дима_
(defun block-bound-box(ent / minpt maxpt)
  ((lambda (ent-ob)
     (if (= (cdr (assoc 0 (entget (car ent-ob)))) "INSERT")
         ((lambda (lst-ob)
            ((lambda (lst-minpt-maxpt)
               (mapcar 'vla-delete lst-ob)
               ((lambda (lst-minpt lst-maxpt)
                  (cons (list (apply 'min (mapcar 'car lst-minpt))
                              (apply 'min (mapcar 'cadr lst-minpt))
                              0.0)
                        (list (apply 'max (mapcar 'car lst-maxpt))
                              (apply 'max (mapcar 'cadr lst-maxpt))
                              0.0)))
                (mapcar 'car lst-minpt-maxpt)
                (mapcar 'cdr lst-minpt-maxpt)))
             (mapcar 'block-bound-box lst-ob)))
          (vlax-safearray->list (vlax-variant-value (vla-explode (cdr ent-ob)))))
         (progn (vla-getboundingbox (cdr ent-ob) 'minpt 'maxpt)
                (cons (vlax-safearray->list minpt) (vlax-safearray->list maxpt)))))
   (if (= (type ent) 'ename)
       (cons ent (vlax-ename->vla-object ent))
       (cons (vlax-vla-object->ename ent) ent)))
)
(defun test-bound (pt1-pt2)
(setq gpt1 (car pt1-pt2) gpt2 (cdr pt1-pt2))
(vl-cmdf "_RECTANG" "_none" gpt1 "_none" gpt2)
(setq rect (entlast))
)
(test-bound (block-bound-box rbl))
;;;
(vl-cmdf "_ROTATE" rbl rect "" ptrot (- 0 ugol))
(vl-cmdf "_EXPLODE" rbl)
(vl-cmdf "_-PURGE" "_B" "" "_N")
(princ "\n\nГабарит построен")
(setvar "CMDECHO" echo)
(princ)
)
Обсуждение темы см. здесь:
http://forum.dwg.ru/showthread.php?t=14437
Допускаю, что программа может быть улучшена.
Просмотров: 503
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Готовые программы > LISP. Построение габаритного контура для нескольких объектов с заданием поворота этого контура.

Завод ГРАД предлагает муфты для стыковки строительной арматуры и резьбонакатные станки отечественного производства
Опции темы Поиск в этой теме
Поиск в этой теме:

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

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Может есть lisp для копирования объектов из разных блоков в пространство чертежа ? Куинбус Флестрин LISP 6 30.12.2016 15:24
Прошу добавить в макрос массового поворота объектов функцию RANDOM MrBrown LISP 4 27.10.2016 09:22
Lisp выполняемый в нескольких рисунках Iory LISP 9 25.12.2010 11:28
При вычитании нескольких 3D тел они объединяются в одно. Можно ли этого избежать? sanchez206283 AutoCAD 3 28.10.2010 11:47
Lisp для редактирования нескольких мтекстов сразу Red Nova LISP 5 17.03.2008 21:28

|| Главная || Каталог САПР || Тендеры || Публикации || Объявления || Биржа труда || Download || Галерея ||
|| Библиотека || Кунсткамера || Каталог предприятий || Контакты || Файлообменник || Блоги ||


Размещение рекламы