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

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

Объект описанный прямоугольником

Ответ
Поиск в этой теме
Непрочитано 16.11.2009, 15:12 #1
Объект описанный прямоугольником
Positron
 
Регистрация: 25.06.2009
Сообщений: 147

Есть такая задачка:
Необходимо узнать габариты объекта по крайним (верхушкам) по оси ох и оу и вписать по ним прямоугольник...
-Объект или множество выделенных объектов
-Не учитывать размеры и текст
Просмотров: 4967
 
Непрочитано 16.11.2009, 15:14
#2
Рyslan


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


нифига не понял
Рyslan вне форума  
 
Непрочитано 16.11.2009, 15:41
#3
Хмурый


 
Регистрация: 29.10.2004
СПб
Сообщений: 16,327


команда _list для твёрдого тела.
для области- тоже самое.
преобразуй замкнутые контуры в области, объедини их в одну и дай команду _list

_list
1 found

3DSOLID Layer: "0"
Space: Model space
Handle = 484
History = None
Show History = No
Solid type = Extrusion
Extrusion height: 100.0000
Taper angle: 0.000
Bounding Box: Lower Bound X = 88.1767 , Y = 137.3792 , Z = 0.0000
Upper Bound X = 133.0443 , Y = 182.2469 , Z = 100.0000

Последний раз редактировалось Хмурый, 16.11.2009 в 15:49.
Хмурый вне форума  
 
Автор темы   Непрочитано 16.11.2009, 17:34
#4
Positron


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


Цитата:
Сообщение от Хмурый Посмотреть сообщение
команда _list для твёрдого тела.
для области- тоже самое.
преобразуй замкнутые контуры в области, объедини их в одну и дай команду _list
А как извлеч иммено координаты верхушок(самые крайние по оси ох и оу)... показую на примере, 2 объекта, независимые, попали под выделение...

Если такие тела в регион то получится:

REGION Layer: "01 BASIC"
Space: Model space
Handle = c7bb7
Area: 506340.6
Perimeter: 2522.5
Bounding Box: Lower Bound X = 14899.7 , Y = 3121.2 , Z = 0.0
Upper Bound X = 15702.6 , Y = 3924.1 , Z = 0.0
REGION Layer: "01 BASIC"
Space: Model space
Handle = c7bb6
Area: 2207418.1
Perimeter: 6321.5
Bounding Box: Lower Bound X = 15129.9 , Y = 2678.0 , Z = 0.0
Upper Bound X = 17501.5 , Y = 4510.3 , Z = 0.0
CIRCLE Layer: "02 DIM (1х08-10)"
Space: Model space
Handle = c7bb5
center point, X= 15301.1 Y= 3522.7 Z= 0.0

....
А теперь как извлеч именно те кординаты што нада через код...
Bounding Box: Lower Bound X = 14899.7 , Y = 3121.2 , Z = 0.0
Bounding Box:
Upper Bound X = 17501.5 , Y = 4510.3 , Z = 0.0

нарисовать прямоугольник по ним и удалить регион...
Миниатюры
Нажмите на изображение для увеличения
Название: Прямоугольник по 2-м точкам.jpg
Просмотров: 84
Размер:	13.7 Кб
ID:	28988  

Последний раз редактировалось Positron, 16.11.2009 в 18:01.
Positron вне форума  
 
Непрочитано 16.11.2009, 22:39
#5
igorni


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


Для областей и тел подойдет и _massprop. В выдаче комманды будет
Area: 2490.6315
Perimeter: 366.1152
Bounding box: X: 130.1098 -- 211.1247
Y: 151.7388 -- 202.2644

Centroid: X: 166.6043
Y: 178.3951
Moments of inertia: X: 79776646.7362
.......
igorni вне форума  
 
Непрочитано 16.11.2009, 23:21
#6
Кулик Алексей aka kpblc
Moderator

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


Насколько я помню, то ли на этом форуме, то ли на caduser.ru выкладывались решения по обнаружению границ нескольких объектов... Если честно - искать лениво, а рисовать свое решение - долго.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 17.11.2009, 10:41
#7
Дима_

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


командой obvod:
Код:
[Выделить все]
(defun c:obvod ( / lstpt)
(setq	lstpt	(apply 'append (mapcar '(lambda (obj / minpt maxpt)
		(vla-getboundingbox obj 'minpt 'maxpt)
		(mapcar 'vlax-safearray->list (list minpt maxpt))
		);end of lambda
		(mapcar 'vlax-ename->vla-object (sstolist (ssget)))))
);end of setq
(pln (list
		(list (apply 'min (mapcar 'car lstpt)) (apply 'min (mapcar 'cadr lstpt)))
		(list (apply 'max (mapcar 'car lstpt)) (apply 'min (mapcar 'cadr lstpt)))
		(list (apply 'max (mapcar 'car lstpt)) (apply 'max (mapcar 'cadr lstpt)))
		(list (apply 'min (mapcar 'car lstpt)) (apply 'max (mapcar 'cadr lstpt)))
		);end of list
T);end of pln
);end of obvod

;************

(defun sstolist (ss / i lst); конвертирует набор в список
(setq i 0)
(if ss
(repeat (sslength ss)
(setq lst (append lst (list (ssname ss i))) i (1+ i))
));end of repeat & if
lst
);end of sstolist

(defun pln (lst c); создает полилинию по списку вершин lst, c - nil/T - разомкн/замкнт или '(с слой цвет).
(entmakex (append
(list (cons 0 "LWPOLYLINE")(cons 100 "AcDbEntity")(cons 100 "AcDbPolyline") (cons 90 (length lst)))
(if (= (type c) 'list)
(vl-remove nil (list
(if (car c) (cons 70 1) (cons 70 0))
(if (cadr c) (cons 8 (cadr c)))
(if (caddr c) (cons 62 (caddr c)))
));end of list & vl-remove
(list (if c (cons 70 1) (cons 70 0)))
);end of if
(mapcar '(lambda (x) (cons 10 x)) lst)
));end of apend & entmakex
);end of pln
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Автор темы   Непрочитано 17.11.2009, 10:53
#8
Positron


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


Цитата:
Сообщение от Дима_ Посмотреть сообщение
командой obvod:
Код:
[Выделить все]
(defun c:obvod ( / lstpt)
(setq	lstpt	(apply 'append (mapcar '(lambda (obj / minpt maxpt)
		(vla-getboundingbox obj 'minpt 'maxpt)
		(mapcar 'vlax-safearray->list (list minpt maxpt))
		);end of lambda
		(mapcar 'vlax-ename->vla-object (sstolist (ssget)))))
);end of setq
(pln (list
		(list (apply 'min (mapcar 'car lstpt)) (apply 'min (mapcar 'cadr lstpt)))
		(list (apply 'max (mapcar 'car lstpt)) (apply 'min (mapcar 'cadr lstpt)))
		(list (apply 'max (mapcar 'car lstpt)) (apply 'max (mapcar 'cadr lstpt)))
		(list (apply 'min (mapcar 'car lstpt)) (apply 'max (mapcar 'cadr lstpt)))
		);end of list
T);end of pln
);end of obvod

;************

(defun sstolist (ss / i lst); конвертирует набор в список
(setq i 0)
(if ss
(repeat (sslength ss)
(setq lst (append lst (list (ssname ss i))) i (1+ i))
));end of repeat & if
lst
);end of sstolist

(defun pln (lst c); создает полилинию по списку вершин lst, c - nil/T - разомкн/замкнт или '(с слой цвет).
(entmakex (append
(list (cons 0 "LWPOLYLINE")(cons 100 "AcDbEntity")(cons 100 "AcDbPolyline") (cons 90 (length lst)))
(if (= (type c) 'list)
(vl-remove nil (list
(if (car c) (cons 70 1) (cons 70 0))
(if (cadr c) (cons 8 (cadr c)))
(if (caddr c) (cons 62 (caddr c)))
));end of list & vl-remove
(list (if c (cons 70 1) (cons 70 0)))
);end of if
(mapcar '(lambda (x) (cons 10 x)) lst)
));end of apend & entmakex
);end of pln
Спасибо, то што надо
...
А возможно ещо добавить сюда игнорирование:
-Мтекста
-размеров
-таблиц

во вложении пример
Миниатюры
Нажмите на изображение для увеличения
Название: Зелёным тот шо нада, синим то шо есть.jpg
Просмотров: 84
Размер:	26.4 Кб
ID:	29026  
Вложения
Тип файла: dwg
DWG 2004
Зелёным тот шо нада, синим то шо есть.dwg (71.6 Кб, 550 просмотров)

Последний раз редактировалось Positron, 17.11.2009 в 11:24. Причина: Добавил вложения
Positron вне форума  
 
Непрочитано 17.11.2009, 14:50
#9
Do$

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


Cтрочку:
(mapcar 'vlax-ename->vla-object (sstolist (ssget)))))
Замени на:
(mapcar 'vlax-ename->vla-object (vl-remove-if '(lambda (a) (wcmatch (cdr (assoc 0 (entget a))) "MTEXT,DIMENSION,*TABLE")) (sstolist (ssget))))))
Do$ вне форума  
 
Автор темы   Непрочитано 17.11.2009, 18:12
#10
Positron


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


Цитата:
Сообщение от Do$ Посмотреть сообщение
Cтрочку:
(mapcar 'vlax-ename->vla-object (sstolist (ssget)))))
Замени на:
(mapcar 'vlax-ename->vla-object (vl-remove-if '(lambda (a) (wcmatch (cdr (assoc 0 (entget a))) "MTEXT,DIMENSION,*TABLE")) (sstolist (ssget))))))
спс! работает
Positron вне форума  
 
Непрочитано 30.07.2020, 11:15
#11
NemoSUN


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


Цитата:
Сообщение от Дима_ Посмотреть сообщение
командой obvod:
У меня почему-то не хочет работать. Выдаёт ; error: no function definition: nil

P.S. Autocad 2010
NemoSUN вне форума  
 
Непрочитано 30.07.2020, 12:10
#12
AlexCondor

инженер
 
Регистрация: 03.08.2007
Сообщений: 1,326


Цитата:
Сообщение от NemoSUN Посмотреть сообщение
У меня почему-то не хочет работать
Должно работать. Чаще всего оказывается что не правильно скопирован текст. Проверьте....
AlexCondor вне форума  
 
Непрочитано 30.07.2020, 15:13
#13
NemoSUN


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


Цитата:
Сообщение от AlexCondor Посмотреть сообщение
Должно работать. Чаще всего оказывается что не правильно скопирован текст. Проверьте....
Попробовал. Всё равно. Ошибка возникает после выбора объектов и нажатия Enter.
NemoSUN вне форума  
 
Непрочитано 30.07.2020, 15:19
#14
NemoSUN


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


Приложил файл для подтверждения
Вложения
Тип файла: lsp Obvod.lsp (1.4 Кб, 8 просмотров)
NemoSUN вне форума  
 
Непрочитано 30.07.2020, 15:46
#15
AlexCondor

инженер
 
Регистрация: 03.08.2007
Сообщений: 1,326


В новом dwg тоже не работает?
AlexCondor вне форума  
 
Непрочитано 30.07.2020, 15:51
#16
NemoSUN


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


Цитата:
Сообщение от AlexCondor Посмотреть сообщение
В новом dwg тоже не работает?
Я в новом файле только и пробую.
NemoSUN вне форума  
 
Непрочитано 30.07.2020, 15:57
#17
AlexCondor

инженер
 
Регистрация: 03.08.2007
Сообщений: 1,326


Попробовать загрузить (vl-load-com)...
AlexCondor вне форума  
 
Непрочитано 30.07.2020, 16:27
#18
NemoSUN


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


Цитата:
Сообщение от AlexCondor Посмотреть сообщение
Попробовать загрузить (vl-load-com)...
Всё поехало ) Спасибо )
NemoSUN вне форума  
 
Непрочитано 10.02.2023, 16:07
#19
NemoSUN


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


Помогите переписать lisp
Код:
[Выделить все]
(defun c:around (/ adoc selset lst-getboundingbox pt)
  (defun lst-getboundingbox (lst)
    ;; Получение габаритного контейнера списка vla-указателей на объекты
    ;; Автор: Евгений Елпанов
    ;; https://www.caduser.ru/forum/topic22552.html
    (if (and lst (listp lst))
      ((lambda (x)
         (list
           (apply
             (function mapcar)
             (cons (function min) (mapcar (function car) x))
             ) ;_ end of apply
           (apply
             (function mapcar)
             (cons (function max) (mapcar (function cadr) x))
             ) ;_ end of apply
           ) ;_ end of list
         ) ;_ end of lambda
        (vl-remove-if
          (function null)
          (mapcar
            (function
              (lambda (x / minp maxp)
                (if (not (vl-catch-all-error-p
                           (vl-catch-all-apply
                             (function vla-getboundingbox)
                             (list x 'minp 'maxp)
                             ) ;_ end of vl-catch-all-apply
                           ) ;_ end of vl-catch-all-error-p
                         ) ;_ end of not
                  (list (vlax-safearray->list minp)
                        (vlax-safearray->list maxp)
                        ) ;_ end of list
                  ) ;_ end of if
                ) ;_ end of lambda
              ) ;_ end of function
            lst
            ) ;_ end of mapcar
          ) ;_ end of vl-remove-if
        )
      ) ;_ end of if
    ) ;_ end of defun
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if (and (setq selset (ssget "_:L"))
           (setq
             pt (lst-getboundingbox
                  (mapcar 'vlax-ename->vla-object
                          (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
                          ) ;_ end of mapcar
                  ) ;_ end of lst-getboundingbox
             ) ;_ end of setq
           ) ;_ end of and
    (command "_.rectang" (car pt) (cadr pt))
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun
Чтобы даже при выделении всех объектов обводить каждый объект в отдельности, а не все сразу.

P.S. я писал автору на caduser, но без ответа.

Последний раз редактировалось NemoSUN, 10.02.2023 в 16:22.
NemoSUN вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > AutoCAD > Объект описанный прямоугольником

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Объединение дуг, линий в единый объект, Как объединить? Vladimir.P AutoCAD 41 25.01.2015 08:03
Объект убегает вниз XYZ AutoCAD 24 12.11.2013 08:55
Линейный объект "Тепловые сети" Противопожарные мероприятия" Route Инженерные сети 8 14.03.2012 13:03
Главспец на один объект по трудовому договору - возможно ли? Jull Профессии и трудовые отношения 7 24.08.2007 08:09
Как удалить объект Autodesk Building Systems из файла? hook AutoCAD 1 22.08.2007 02:06