Vla-getboundingbox для нескольких блоков

Vla-getboundingbox для нескольких блоков · 15.07.2024, 16:12

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

Помогите доработать функцию от Евгения Елпанова под данную задачу:
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))) с выбором блоков "по одному". Но из-за большого кол-ва блоков выходит долго..

Кулик Алексей aka kpblc · 17.07.2024, 12:41

Но хендлы будут заняты, насколько я понимаю.

Сергей812 · 17.07.2024, 12:58

Цитата:

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

Но хендлы будут заняты, насколько я понимаю.

ну да, так давно уже 64 битные ключи в БД чертежа)

name02 · 17.07.2024, 13:34

Цитата:

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

Еще такой интересный вопрос: можно ли получить габариты блока без учета включенного в него текста?

В свое время я делал по найденному из интернета - код не сильно менял, поэтому как есть...
Обращаю внимание, что габаритный размер определяется для ОПИСАНИЯ блока, а не вхождения (вставки) блока в чертеже!
Т.е. при определении габарита вставки блока нужно еще дополнительно учесть масштаб. Ну и поворот блока тоже надо как-то учитывать
Я делал эту программу для автоматической печати чертежей, поэтому у меня вопрос про учет поворота блоков не стоял

Код:

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

 ;|Программа выдает координаты нижней левой и верхней правой точек 
;;относительно точки начала координат описания блока в виде списка из двух трехмерных координат
;;Пример работы
 (get_BlockVisibleObjectsBoundaries (car(entsel))

Пример результата:
((-100.0 0.0 0.0) (0.0 52.3 0))
|;
(defun get_BlockVisibleObjectsBoundaries (block_entity / blkname ent LL UR ell eur)
  (setq blkname (cdr (assoc 2 (entget block_entity))))

  (setq
    ent	(tblobjname "block" blkname)
    LL	nil
    UR	nil
  ) ;_ end of setq
  (while (setq ent (entnext ent))
    ;; здесь идет фильтрация объектов, определяющих габариты блока
    ;; в данном случае это не атрибуты, не ТЕКСТ или МТЕКСТ, а остальные видимые объекты
    (if	(AND (/= (cdr (assoc 0 (entget ent))) "ATTDEF")
                 (wcmatch (cdr (assoc 0 (entget ent))) "~*TEXT")
                 (= (vla-get-VISIBLE (vlax-ename->vla-object ent)) :vlax-true)
         ) ;_ end of AND
         (progn
	    (vla-getboundingbox (vlax-ename->vla-object ent) 'mi 'ma)
	    (setq
	       ell (vlax-safearray->list mi)	; = Entity's Lower Left
	       eur (vlax-safearray->list ma)	; = Entity's Upper Right
	       LL  (if LL
		        (mapcar 'min LL ell)
		        ell
	            ) ;_ end of if
	       UR  (if UR
		          (mapcar 'max UR eur)
		          eur
	             ) ;_ end of if
	    ) ;_ end of setq
        ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of while

  (list LL UR)

) ;_ end of defun

Gretech89 · 17.07.2024, 16:27

Цитата:

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

В свое время я делал по найденному из интернета - код не сильно менял, поэтому как есть...

Фильтрация отлично работает. А возможно ли ее использовать для вхождений блока? Было бы здорово внедрить ее в код в п. #12 (от koMon).

koMon · 18.07.2024, 09:30

Gretech89,
как-то так, практически

Код:

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

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

(defun get_block_bb (insert / llc_ruc_list llc ruc)
	(setq llc_ruc_list '((1e300 1e300) (-1e-300 -1e-300)))
	(vlax-map-collection (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
						 		   (vla-get-effectivename insert)
						 )
		'(lambda (object)
			(if (not (member (read (vla-get-objectname object)) '(AcDbText AcDbMtext AcDbAttributeDefinition)))
				(progn
					(vla-getboundingbox object 'llc 'ruc)
					(setq llc_ruc_list (mapcar '(lambda (compare test_corner corner) (mapcar compare test_corner corner ))
											   '(min max) (mapcar 'vlax-safearray->list (list llc ruc)) llc_ruc_list
									   )
					)
				)
			)
		 )
	)
	llc_ruc_list
)

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

(defun trans_point (point scale_x scale_y rotation insertion_point)
	  (list
		  (+ (* (car point) scale_x (cos rotation)) (- (* (cadr point) scale_y (sin rotation))) (car insertion_point))
		  (+ (* (car point) scale_x (sin rotation))    (* (cadr point) scale_y (cos rotation))  (cadr insertion_point))
	  )
)

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

(defun c:draw_diagonal (/ insert_list scale_x scale_y rotation insertion_point block_bb_data block_parsed_list llc ruc diagonal)
	(prompt "\nВыберите блоки для разметки")
	(setq insert_list (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "insert"))))))))
	(mapcar '(lambda (insert)
				(setq scale_x (vla-get-xeffectivescalefactor insert)
					  scale_y (vla-get-yeffectivescalefactor insert)
					  rotation (vla-get-rotation insert)
					  insertion_point (vlax-get insert 'insertionpoint)
				)
				(if (setq block_bb_data (assoc (vla-get-effectivename insert) block_parsed_list))
						(setq llc (caadr block_bb_data) ruc (cadadr block_bb_data))
						(setq block_parsed_list (append block_parsed_list (list (setq block_bb_data (get_block_bb insert))))
							  llc (car block_bb_data) ruc (cadr block_bb_data)
						)
				)
				(setq diagonal (vla-addline (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
								   			(vlax-3d-point (trans_point (mapcar '+ (list 0 (/ 100.0 scale_y)) llc)
														   				scale_x scale_y rotation insertion_point
														   )
											)
											(vlax-3d-point (trans_point (mapcar '+ (list 0 (/ 100.0 scale_y)) ruc)
														   				scale_x scale_y rotation insertion_point
														   )
											)
							   )
				)

			 )
			 insert_list
	)
	(princ)
)

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

name02 · 18.07.2024, 09:43

Закрывающую скобку не поставил для (defun c:draw_diagonal...
И второе еще - смещение диагонали происходит по направлению Y блока, т.е. если блок повернуть на 90 градусов, то диагональ нарисуется со смещением по горизонтали. Как надо-то?

koMon · 18.07.2024, 09:45

Gretech89 · 18.07.2024, 11:45

Цитата:

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

как-то так

Вроде раскурил)) Спасибо большое, всё замечательно. У меня еще вот такой вопрос.
Из кода в п. #12 я мог взять координаты и далее использовать их как захочу, присвоив их переменным minp и maxp:

Код:

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

 (setq minp (vlax-safearray->list llc))
(setq maxp (vlax-safearray->list urc))

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

----- добавлено через ~13 мин. -----

Цитата:

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

И второе еще - смещение диагонали происходит по направлению Y блока, т.е. если блок повернуть на 90 градусов, то диагональ нарисуется со смещением по горизонтали. Как надо-то?

Ну, это не критично. В моем случае все блоки с углом поворота 0 градусов.

koMon · 18.07.2024, 12:01

проиллюстрируйте на примере какие конкретно координаты нужны.
если нужны транспонированные кординаты ЛНУ и ПВУ описывающего контура блока, то их можно взять так между (if и (setq diagonal

Код:

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

 
(trans_point llc scale_x scale_y rotation insertion_point)
(trans_point ruc scale_x scale_y rotation insertion_point)

Gretech89 · 18.07.2024, 12:26

Цитата:

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

если нужны транспонированные кординаты ЛНУ и ПВУ описывающего контура блока, то их можно взять так между (if и (setq diagonal

Да, именно они. Благодарю

Gretech89 · 17.09.2024, 17:17

koMon, появилась еще необходимость после разметки блоков полилиниями сместить все блоки в сторону по следующему принципу:
1. Первый блок переместить в точку 0,0; 2) Второй и последующие расставить с шагом 1000 относительно друг друга. См. рис.
Я так понимаю без цикла тут не обойтись. Все блоки разные по размеру и нужно их обрабатывать по отдельности. Т.е. положение каждого блока будет зависеть от положения (размера) предыдущего.
Код я дополнил, как я это вижу (строчки 60-73). Помогите, пожалуйста, с циклом. Или может это реализуется как-то по-иному?

Код:

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

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

(defun get_block_bb (insert / llc_ruc_list llc ruc)
	(setq llc_ruc_list '((1e300 1e300) (-1e-300 -1e-300)))
	(vlax-map-collection (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
						 		   (vla-get-effectivename insert)
						 )
		'(lambda (object)
			(if (not (member (read (vla-get-objectname object)) '(AcDbText AcDbMtext AcDbAttributeDefinition)))
				(progn
					(vla-getboundingbox object 'llc 'ruc)
					(setq llc_ruc_list (mapcar '(lambda (compare test_corner corner) (mapcar compare test_corner corner ))
											   '(min max) (mapcar 'vlax-safearray->list (list llc ruc)) llc_ruc_list
									   )
					)
				)
			)
		 )
	)
	llc_ruc_list
)

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

(defun trans_point (point scale_x scale_y rotation insertion_point)
	  (list
		  (+ (* (car point) scale_x (cos rotation)) (- (* (cadr point) scale_y (sin rotation))) (car insertion_point))
		  (+ (* (car point) scale_x (sin rotation))    (* (cadr point) scale_y (cos rotation))  (cadr insertion_point))
	  )
)

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

(defun c:draw_diagonal (/ insert_list scale_x scale_y rotation insertion_point block_bb_data block_parsed_list llc ruc diagonal)
	(prompt "\nВыберите блоки для разметки")
	(setq insert_list (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "insert"))))))))
	(mapcar '(lambda (insert)
				(setq scale_x (vla-get-xeffectivescalefactor insert)
					  scale_y (vla-get-yeffectivescalefactor insert)
					  rotation (vla-get-rotation insert)
					  insertion_point (vlax-get insert 'insertionpoint)
				)
				(if (setq block_bb_data (assoc (vla-get-effectivename insert) block_parsed_list))
						(setq llc (caadr block_bb_data) ruc (cadadr block_bb_data))
						(setq block_parsed_list (append block_parsed_list (list (setq block_bb_data (get_block_bb insert))))
							  llc (car block_bb_data) ruc (cadr block_bb_data)
						)
				)
				(setq diagonal (vla-addline (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
								   			(vlax-3d-point (trans_point (mapcar '+ (list 0 (/ 100.0 scale_y)) llc)
														   				scale_x scale_y rotation insertion_point
														   )
											)
											(vlax-3d-point (trans_point (mapcar '+ (list 0 (/ 100.0 scale_y)) ruc)
														   				scale_x scale_y rotation insertion_point
														   )
											)
							   )
				)
				; перемещаем 1ый блок в начальную точку 0,0
				(setq minp (trans_point llc scale_x scale_y rotation insertion_point)) ; габаритные координаты minp 1го блока
				(setq start_point (vlax-3D-point (trans (list 0 0) 1 0))) ; задаем начальную точку - 0,0
					(setq trans_minp (vlax-3D-point (trans minp 1 0))) ; преобразуем габаритные координаты minp 1го блока
		   				(vla-move insert trans_minp start_point) ; перемещаем 1ый блок

				; далее цикл по расстановке остальных блоков
				(setq minp (trans_point llc scale_x scale_y rotation insertion_point)) ; габаритные координаты minp 1го блока
				(setq maxp (trans_point ruc scale_x scale_y rotation insertion_point)) ; габаритные координаты maxp 1го блока
					(setq trans_minp (vlax-3D-point (trans minp 1 0))) ; преобразуем габаритные координаты minp 1го блока
					(setq step (+ (car maxp) 1000)) ; определяем шаг вставки 2го блока
					(setq insert_point (polar minp 0 step)) ; определяем координаты вставки 2го блока
					(setq trans_insert_point (vlax-3D-point (trans insert_point 1 0))) ; преобразуем координаты вставки 2го блока
		   				(vla-move insert trans_minp trans_insert_point) ; перемещаем 2ой блок
		   
			 )
			 insert_list
	)
	(princ)
)

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

koMon · 18.09.2024, 10:33

Gretech89,
построить блоки (без поворотов) по линии от 0,0 через 1000.

Код:

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

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

(defun get_block_bb (insert / llc_ruc_list llc ruc)
	(setq llc_ruc_list '((1e300 1e300) (-1e-300 -1e-300)))
	(vlax-map-collection (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
						 		   (vla-get-effectivename insert)
						 )
		'(lambda (object)
			(if (not (member (read (vla-get-objectname object)) '(AcDbText AcDbMtext AcDbAttributeDefinition)))
				(progn
					(vla-getboundingbox object 'llc 'ruc)
					(setq llc_ruc_list (mapcar '(lambda (compare test_corner corner) (mapcar compare test_corner corner ))
											   '(min max) (mapcar 'vlax-safearray->list (list llc ruc)) llc_ruc_list
									   )
					)
				)
			)
		 )
	)
	llc_ruc_list
)

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

(defun trans_point (point scale_x scale_y rotation insertion_point)
	 (list
	   	(+ (* (car point) scale_x (cos rotation)) (- (* (cadr point) scale_y (sin rotation))) (car insertion_point))
	   	(+ (* (car point) scale_x (sin rotation))    (* (cadr point) scale_y (cos rotation))  (cadr insertion_point))
	 )
)

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

(defun aheadd_zeroes (string total_length)
	(strcat (substr "00000" 1 (- total_length (strlen string))) string) 
)

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

(defun c:line_up_inserts (/ insert_list scale_x scale_y rotation insertion_point block_bb_data block_parsed_list llc ruc
						  	diagonal not_first reference_point
					   	 )
	(prompt "\nВыберите блоки для построения в линию x1000 от 0,0...")
	(setq insert_list (vl-sort (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "insert")))))))
			    	  		  '(lambda (insert_1 insert_2) (< (aheadd_zeroes (vla-get-effectivename insert_1) 5) 
					  								  	   	  (aheadd_zeroes (vla-get-effectivename insert_2) 5)
									   					   )
							   )
			  		  )
	)
	(mapcar '(lambda (insert)
				(setq scale_x (vla-get-xeffectivescalefactor insert)
					  scale_y (vla-get-yeffectivescalefactor insert)
					  rotation (vla-get-rotation insert)
					  insertion_point (vlax-get insert 'insertionpoint)
				)
				(if (setq block_bb_data (assoc (vla-get-effectivename insert) block_parsed_list))
						(setq llc (caadr block_bb_data) ruc (cadadr block_bb_data))
						(setq block_parsed_list (append block_parsed_list (list (setq block_bb_data (get_block_bb insert))))
							  llc (trans_point (car block_bb_data) scale_x scale_y rotation insertion_point)
							  ruc (trans_point (cadr block_bb_data) scale_x scale_y rotation insertion_point)
						)
				)
				(if not_first
					(progn
						(vla-move insert (vlax-3d-point llc)
										 (vlax-3d-point (setq reference_point (mapcar '+ (list 1000 0) reference_point)))
						)
						(setq reference_point (mapcar '+ (list (- (car ruc) (car llc)) 0) reference_point))
					)
					(progn
						(vla-move insert (vlax-3d-point llc) (vlax-3d-point 0 0))
						(setq not_first t
							  reference_point (list (- (car ruc) (car llc)) 0)
						)
					)
				)
			 )
			 insert_list
	)
	(princ)
)

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

Gretech89 · 18.09.2024, 10:49

Цитата:

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

построить блоки (без поворотов) по линии от 0,0 через 1000.

Гениально!) Спасибо большое, koMon!

Gretech89 · 19.09.2024, 17:44

koMon, при выделении блоков рамкой какие-то блоки могут построиться в обратном порядке, какие-то в хаотичном, относительно их первоначального положения в модели. Например, блоки с именами "01", "02", "03" могут построиться в линию в порядке "03", "02", "01". Какова логика их расстановки? В идеале хотелось бы, чтобы блоки расстанавливались в таком же порядке, как они и стояли в первоначальном положении. Либо по возрастанию в соответствии с их именами ("01", "02", "03").

koMon · 19.09.2024, 20:22

Gretech89,
сортировку по имени добавил выше.

Gretech89 · 20.09.2024, 10:36

Цитата:

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

Gretech89,
сортировку по имени добавил выше.

Отлично. А можно ли победить такой "баг" сортировки: 1, 10, 11, ..., 19, 2, 20, 21... ?

koMon · 20.09.2024, 11:23

Цитата:

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

Отлично. А можно ли победить такой "баг" сортировки: 1, 10, 11, ..., 19, 2, 20, 21... ?

да, см. выше.

Gretech89 · 20.09.2024, 14:37

Цитата:

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

да, см. выше.

Благодарю! Но т.к. имена файлов могут быть до 20 символов (в моем случае), я изменил строчки 35, 45 и 46. Надеюсь верно.

Код:

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

 (strcat (substr "00000000000000000000" 1 (- total_length (strlen string))) string)

Код:

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

 '(lambda (insert_1 insert_2) (< (aheadd_zeroes (vla-get-effectivename insert_1) 20) 
(aheadd_zeroes (vla-get-effectivename insert_2) 20)

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Как сделать "attsync" для одного или нескольких выбранных блоков?	Nike	Программирование	17	21.12.2016 09:15
Редактирование одновременно нескольких блоков без атрибутов	Кукурузо_Джон_Горыныч	AutoCAD	17	08.07.2016 11:40
Копирование текста из нескольких текстовых блоков	sergey8477	AutoCAD	5	04.03.2015 12:49
Максимальные размеры полистиролбетонных блоков. Перевязка	gdenisn	Конструкции зданий и сооружений	18	20.08.2012 22:34
Замена списка блоков соответствующим списком блоков, но другого масштаба	АKA	AutoCAD	12	11.03.2012 06:25