[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% засорять базу чертежа

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

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

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

[Сергей812]

Сообщение от Кулик Алексей aka kpblc Но хендлы будут заняты, насколько я понимаю.

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

[name02]

Сообщение от 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]

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

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

[koMon]

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]

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

[koMon]

[Gretech89]

Сообщение от koMon как-то так

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

Код:

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

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

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

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

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

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

[koMon]

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

Код:

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

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

[Gretech89]

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

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

[Gretech89]

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]

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]

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

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

[Gretech89]

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

[koMon]

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

[Gretech89]

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

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

[koMon]

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

да, см. выше.

[Gretech89]

Сообщение от 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)