[Gretech89]

Всем доброго времени суток!

Помогите доработать функцию от Евгения Елпанова под данную задачу:
1) Определить габаритные координаты нескольких блоков (не динамических);
2) Построить по данным координатам полилинии.

Данный ЛИСП я так понял определяет 2 пары габаритных координат (минимум-максимум для выделенных блоков), а не список отдельно для каждого блока.

Код:

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

 ;**************** lst-getboundingbox.lsp *************
;   Функция    определения габаритного контейнера
;   для списка VLA объектов
;   Автор  Евгений Елпанов.
;*****************************************************
;   Аргумент lst - список VLA объектов
;   пример получения списка с использованием (ssget) :
(if (setq sset (ssget))
 (setq lst
       (mapcar
        (function vlax-ename->vla-object)
        (vl-remove-if
         (function listp)
         (mapcar (function cadr) (ssnamex sset))
        ) ;_ vl-remove-if
       ) ;_  mapcar
 ) ;_  setq
)
;   Пример вызова:
 (lst-getboundingbox lst)
;   Возвращает список из двух 3d точек
;   '((левая нижняя) (правая верхняя))
|;
;|==========================================================================|;
(defun lst-getboundingbox (lst / maxp minp)
  (vl-load-com)
  (if (and lst (listp lst))
    (apply
      (function
 (lambda (a1 a2 a3 a4 a5 a6)
   (list
     (list
       (apply (function min) a1)
       (apply (function min) a2)
       (apply (function min) a3)
       ) ;_ end of list
     (list
       (apply (function max) a4)
       (apply (function max) a5)
       (apply (function max) a6)
       ) ;_ end of list
     ) ;_ end of list
   ) ;_ end of lambda
 ) ;_ end of function
      (apply
 (function mapcar)
 (cons
   'list
   (mapcar
     (function
       (lambda (x)
  (vla-getboundingbox x 'minp 'maxp)
  (append
    (vlax-safearray->list minp)
    (vlax-safearray->list maxp)
    ) ;_ end of append
  ) ;_ end of lambda
       ) ;_ end of function
     lst
     ) ;_ end of mapcar
   ) ;_ end of cons
 ) ;_ end of apply
      ) ;_ end of apply
    ) ;_ end of if
 
  ) ;_ end of defun

Пока удалось решить данную задачу через связку (vlax-ename->vla-object (car (entsel))) с выбором блоков "по одному". Но из-за большого кол-ва блоков выходит долго..

[name02]

Если прям надо именно эту функцию использовать:
1 Получаешь набор объектов с помощью (ssget)
2 Организуешь цикл по всем объектам набора
2.1 Каждый из объектов помещаешь в список из одного этого объекта с помощью (list)
2.2 Применяешь функцию - получаешь список координат
2.3 Этот список дописываешь к итоговому списку (cons ...)
3 Конец

[Gretech89]

Сообщение от name02 2.1 Каждый из объектов помещаешь в список из одного этого объекта с помощью (list)

А как по циклу поместить последовательно каждый объект в список? Т.е. я могу выдернуть конкретно 1ый, 2ой, а как это сделать для N-го кол-ва?

[Кулик Алексей aka kpblc]

Через тот же mapcar, к примеру.
Без проверок:

Код:

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

 (defun get-bounding-box-ent-list (elist / pt_list)
  (setq pt_list (apply (function append)
                       (mapcar
                         (function
                           (lambda (ent / mi ma)
                             (if (= (type ent) 'ename)
                               (setq ent (vlax-ename->vla-object ent))
                             )
                             (vla-getboundingbox
                               ent
                               'mi
                               'ma
                             )
                             (mapcar (function vlax-safearray->list) (list mi ma))
                           )
                         )
                         elist
                       )
                )
  )
  (list (apply (function mapcar) (cons (function min) pt_list))
        (apply (function mapcar) (cons (function max) pt_list))
  )
)

[Gretech89]

Сообщение от Кулик Алексей aka kpblc Через тот же mapcar, к примеру.

Спасибо, Алексей! Вариант рабочий.
Попробовал на двух блоках:

Код:

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

 (if (setq sset (ssget))
 (setq lst
       (mapcar
        (function vlax-ename->vla-object)
        (vl-remove-if
         (function listp)
         (mapcar (function cadr) (ssnamex sset))
        ) ;_ vl-remove-if
       ) ;_  mapcar
 ) ;_  setq
)
  (setq pt_list (apply (function append)
                       (mapcar
                         (function
                           (lambda (ent / mi ma)
                             (if (= (type ent) 'ename)
                               (setq ent (vlax-ename->vla-object ent))
                             )
                             (vla-getboundingbox
                               ent
                               'mi
                               'ma
                             )
                             (mapcar (function vlax-safearray->list) (list mi ma))
                           )
                         )
                         lst
                       )
                )
  )

На выходе получил: ((1864.07 1343.36 0.0) (2708.0 1850.05 0.0) (2510.79 2326.44 0.0) (3832.69 2714.16 0.0))
Подскажите еще, пожалуйста, как далее по этому списку пройтись и отрисовать полилинии (по 2 координаты на каждую линию)?

[Кулик Алексей aka kpblc]

Ну, во-первых, скорее всего, понадобится не объединять список точек. Во-вторых, уже получив пары левый-нижний и верхний-правый угол, через тот же mapcar (ну или foreach, на старте не столь уж и важно) - создавать нужные примитивы. Код писать не буду - неинтересно.

[name02]

Сообщение от Gretech89 Подскажите еще, пожалуйста, как далее по этому списку пройтись и отрисовать полилинии (по 2 координаты на каждую линию)?

Вместо 24 строки пропиши это:

Код:

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

 (entmakex (list
    '(0 . "LINE")
     (cons 10 (vlax-safearray->list mi))
     (cons 11 (vlax-safearray->list ma))
  ) ;_ END_OF list
) ;_ END_OF entmakex

[Gretech89]

name02, супер, спасибо!
Но при отрисовке линий возникает ошибка (линии при этом рисуются):
; неверный тип аргумента: listp <Имя объекта: 7883eb0>
Как ее бы пофиксить?

[name02]

Убрал создание списка с координатами и добавил точки отмены - теперь можно по Ctrl-Z отменить нарисованные отрезки

Код:

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

 (defun c:MYPROGRAMM (/ adoc sset lst pt_list)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark adoc)

  (if (setq sset (ssget))
    (setq lst
	   (mapcar
	     (function vlax-ename->vla-object)
	     (vl-remove-if
	       (function listp)
	       (mapcar (function cadr) (ssnamex sset))
	     ) ;_ vl-remove-if
	   ) ;_  mapcar
    ) ;_  setq
  ) ;_ END_OF if

  (mapcar
    (function
      (lambda (ent / mi ma)

	(if (= (type ent) 'ename)
	  (setq ent (vlax-ename->vla-object ent))
	) ;_ END_OF if

	(vla-getboundingbox
	  ent
	  'mi
	  'ma
	) ;_ END_OF vla-getboundingbox

	(entmakex (list
		    '(0 . "LINE")
		    (cons 10 (vlax-safearray->list mi))
		    (cons 11 (vlax-safearray->list ma))
		  ) ;_ END_OF list
	) ;_ END_OF entmakex
      ) ;_ END_OF lambda
    ) ;_ END_OF function
    lst
  ) ;_ END_OF mapcar

  (vla-endundomark adoc)
  (princ)
) ;_ END_OF defun

[Gretech89]

Сообщение от name02 Убрал создание списка с координатами и добавил точки отмены - теперь можно по Ctrl-Z отменить нарисованные отрезки

Благодарствую!) еще вопрос для общего развития: как можно оперировать данными координатами (строчки "34" и "35")? Например, чтобы нарисованные линии были еще смещены вверх по Y на 100? И лучше всего, чтобы линии не после смещались, а в процессе работы функции entmakex, т.е. некая корректировка координат "на лету".

[Кулик Алексей aka kpblc]

С такими вопросами лучше в https://forum.dwg.ru/showthread.php?t=22894

[koMon]

Gretech89,
+

Код:

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

 
(prompt "\nВыберите блоки для разметки")
(setq insert_list (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "insert"))))))))
(mapcar '(lambda (insert)
			(progn 
				(vla-getboundingbox insert 'llc 'urc)
				(setq diagonal (vla-addline (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
							   				(vlax-3d-point (mapcar '+ '(0 100) (vlax-safearray->list llc)))
							   				(vlax-3d-point (mapcar '+ '(0 100) (vlax-safearray->list urc)))
							   )
				)
			)

		 )
		 insert_list
)

[Gretech89]

Сообщение от Кулик Алексей aka kpblc С такими вопросами лучше в https://forum.dwg.ru/showthread.php?t=22894

Спасибо) осваиваю только-только.

----- добавлено через ~4 мин. -----
koMon, спасибо, добрый человек) приятно учиться на примерах.

[Gretech89]

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

[Кулик Алексей aka kpblc]

Чисто теоретически можно. Геморройно только.
Получаешь указатель на описание блока, проходишь по составу, фильтруя элементы, получаешь BoundingBox для каждого элемента, суммируешь. Потом эти точки надо будет трансформировать во вхождение блока (скорее всего, через trans. Хотя могут понадобиться и матрицы, не знаю). И повторяешь операцию вычисления общего BoundingBox по полученным точкам.

[Сергей812]

ну или еще один вариант в случае блока как в п.14 (точка вставки атрибута внутри блока) - запомнить содержимое атрибутов вставки блока, очистить их (атрибуты), "измерить" габариты вставки блока и восстановить содержимое атрибутов)

[Кулик Алексей aka kpblc]

Может не сработать, если атрибут отнесен черт знает куда

[Сергей812]

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

[Кулик Алексей aka kpblc]

Если работать лиспом, то это 100% засорять базу чертежа. А пробрасывать все через ObjectDBX тот еще гемор ИМХО.

[Сергей812]

Сообщение от Кулик Алексей aka kpblc Если работать лиспом, то это 100% засорять базу чертежа

почему засорять - при очистке чертежа эти неиспользуемые определения дубликатов блоков без атрибутов будут удалены. Но не зря назвал костылем же) Просто это может быть для ТС попроще в реализации.