[doslidnik]

Востановить взорваные расчлененные блоки. Создать блоки из одинаковых груп объектов. Задача обратная взрыву расчлененению блока.

Поиск по форуму ничего не дал.
Стоит задача.
Создать блок, блоки по аналогу, по аналогичным одинаковым с выбраными объектами. Востановить удаленные блоки из одинаковых, похожих объектов.

Возможно кто-то встречалься с функционалом. Например кто-то взорвал блоки и потом выделив повторяющиеся объекты команда все их преобразавала в блоки?

У меня на чертеже нарисованы три кружочка в линию. И они встречаються по чертежу сотни раз. Они везде на одинаковом расстоянии друг от друга, одинакового радиуса, слоя, цвета и т.д. Отличие лиш в координатах центров.

Как преобразовать все такие группы объектов в блоки?

[doslidnik]

Сообщение от Кулик Алексей aka kpblc Во вложении - пример

Пример не удачен,
1) вьі взорвали сначала блок, а потом еще взорвали полилилинию у некоторьіх.
2)вьі создали только один блок, но потом у некоторьіх изменили масштаб по х и у не пропорционально да еще и развернули.
У нас блоки до взрьіва не крутились и не масштабировались.
Смотрите вложение.

[crosandr]

Сообщение от Кулик Алексей aka kpblc Как восстанавливать будем-с?

Путем создания набора блоков вместо одного с разными поворотами и масштабными коэффициентами. Я же не утверждал, что мое предложение - панацея. Вариант подойдет для случаев без "фанатизма" с регулярным расположением бывших блоков. Всяко лучше, чем ничего. Тем более, что софт уже имеется. Задача в общем виде конечно круче, но ее еще реализовать нужно.

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

Сообщение от doslidnik вьі взорвали сначала блок, а потом еще взорвали полилилинию у некоторьіх.

Во-первых, полилинии "у некоторых" я не взрывал - нафиг мне такое не упало. Так сработала стандартная _.explode. Во-вторых, это пример на опровержение утверждения, повторю:

Сообщение от crosandr появились одинаковые объекты

Сообщение от doslidnik вьі создали только один блок, но потом у некоторьіх изменили масштаб по х и у не пропорционально да еще и развернули.

А это что, запрещено?

Сообщение от doslidnik У нас блоки до взрьіва не крутились и не масштабировались.

ИМХО частный случай. Тут действительно проще всего создать блок руками и руками же его вставлять, чем париться с написанием кода.

[Boxa]

Сообщение от doslidnik Пример не удачен, ... Смотрите вложение.

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

[Apelsinov]

doslidnik,
У меня по подписи есть сборник функций, в нем есть одна, которая делает в каком-то смысле то, что вы хотите.
Вызывается так: (apel-com '(apel-draw-find_analog_objects))

Работает по габаритам объектов. Чем больше в блоке объектов - тем выше точность. Не учитывает поворот блока. Не учитывает вообще ничего кроме геометрии (слои, цвета и т.п.)

сама функция (с листа работать не будет, т.к. нужны библиотечные функции):

Код:

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

 
(defun apel-draw-find_analog_objects (/		   SS
				      LIST_SS PT2
				      SS0	   list_pt_1
				      opt_2	   OPT_3
				      list_pt_2	   OPT_1
				      list_obj_SS  list_coord_SS
				      List_list_pt LIST_BOXES_SS
				      blk_obj	   LIST_OBJ_SS_LENGTH
				      P1	   P2 list_blocks
				      N POINT_0
				     )
;;;  (apel-com '(apel-draw-find_analog_objects))
;;;-------< ЛОКАЛЬНЫЕ ФУНКЦИИ >------
  (defun _APEL-DRAW-RECTANGLE (list_2_points / pt1 p2 pt3 pt4)
;;;  Отрисовка прямоугольника по двум точкам
    (setq pt1 (car list_2_points))
    (setq pt3 (cadr list_2_points))
    (setq pt2 (list (car pt1) (cadr pt3) 0.0))
    (setq pt4 (list (car pt3) (cadr pt1) 0.0))
    (APEL-DRAW-POLYLINE (list pt1 pt2 pt3 pt4 pt1))
  )
  (defun _apel-point-coord_calc	(xy0 xy xy_ /)
;;;xy0 - координаты относительной точки 0 в глобальной системе
;;;xy - координаты искомой точки в глобальной системе
;;;xy_ - координаты точки относительно точки 0
;;;xy и xy_ могут иметь значение nil
;;;возврат:
;;;xy = nil -> высчитывается xy_
;;;xy_ = nil -> высчитывается xy
;;;  (apel-point-coord_calc '(1 1 0.0) '(3 3 0.0) nil)	-> (2 2 0.0)
;;;  (apel-point-coord_calc '(1 1 0.0) nil '(2 2 0.0))	-> (3 3 0.0)
    (cond
      ((null xy0) (mapcar '- xy xy_))
      ((null xy_) (mapcar '- xy xy0))
      ((null xy) (mapcar '+ xy_ xy0))
    )
  )
    (defun _apel-obj-compare_box (list_pt_0 obj / list_pt_obj)
;;;  Сравнение габаритов
;;;  арг:
;;;  list_pt_0 - относительные габариты для сравнения
;;;  obj - объект для сравнения
;;;  воз:
;;;  абсолютные габариты по объекту, либо nil
    (setq list_pt_obj (apel-BoundingBox obj))
    (if	(equal (_apel-point-coord_calc
		 (car list_pt_obj)
		 (cadr list_pt_obj)
		 nil
	       )
	       list_pt_0
	       0.001
	)
      list_pt_obj
    )
  )
  (defun _apel-BoundingBox_abs->box_otn	(point_0 list_objects)
;;;Получение относительных координат габаритов обьектов по списку
;;;арг:
;;;point_0 - точка, относительно которой пересчитываются координаты
;;;list_objects - список объектов, для получения габаритов
;;; воз: список координат габаритов относительно данной точки, либо nil
    (mapcar (FUNCTION
	      (lambda (i / a)
		(if (setq a (apel-BoundingBox i))
		  (list	(_apel-point-coord_calc point_0 (car a) nil)
			(_apel-point-coord_calc point_0 (cadr a) nil)
		  )
		)
	      )
	    )
	    list_objects
    )
  )
;;;-------< КОНЕЦ ЛОКАЛЬНЫХ ФУНКЦИЙ >------


  (if (and
	(princ "\n Выберите объекты для поиска таких-же:")
	(setq SS (apel-ssget 'nil))	;выборка первая
	(setq list_pt_1 (apel-BoundingBox SS))
					; координаты габаритов первой выборки
	(setq opt_1 (_apel-point-coord_calc
		      (car list_pt_1)
		      (cadr list_pt_1)
		      nil
		    )
	)				;Относительные координаты второй точки габаритов
	(setq list_pt_2 (apel-BoundingBox (vla-item SS 0)))
					;Габариты поискового объекта
	(vlax-for i SS
	  (setq list_obj_SS (cons i list_obj_SS))
	)				;Список объектов из первой выборки
	(princ "\n Выберите объекты среди которых нужно искать:")
	(setq SS0 (apel-ssget 'nil))	;выборка общая, то есть среди чего ищем
	(setq opt_2 (_apel-point-coord_calc
		      (car list_pt_2)
		      (cadr list_pt_2)
		      nil
		    )
	)				;Относительные габариты поискового объекта
	(vlax-for i SS0			; Нахождение списка похожих габаритов по объектам
	  (setq	List_list_pt
		 (cons (_apel-obj-compare_box opt_2 i)
		       List_list_pt
		 )
	  )
	)
	(setq List_list_pt (VL-REMOVE-IF 'null List_list_pt))
	(setq opt_3 (_apel-point-coord_calc
		      (car list_pt_1)
		      (car list_pt_2)
		      nil
		    )
	)				; относительные координаты точки объекта
	(setq
	  list_coord_SS
	   (mapcar
	     (FUNCTION
	       (LAMBDA (i / a)
		 (list
		   (setq a
			  (_apel-point-coord_calc nil i opt_3)
		   )
		   (_apel-point-coord_calc a nil opt_1)
		 )
	       )
	     )
	     (mapcar 'car List_list_pt)
	   )
	)				;Координаты найденых габаритов всех выборок
;;;	(mapcar '_APEL-DRAW-RECTANGLE list_coord_SS)
					; Отрисовываем прямоугольник вокруг каждой будущей выборки

	(setq
	  list_SS (mapcar (FUNCTION
			    (LAMBDA (i / SSi list_obj)
			      (if (setq	SSi
					 (apel-ssget
					   (list
					     "W"
					     (APEL-POINT-LIST_TO_VARIANT
					       (car i)
					     )
					     (APEL-POINT-LIST_TO_VARIANT
					       (cadr i)
					     )
					   )
					 )
				  )
				(vlax-for obj SSi
				  (setq list_obj (cons obj list_obj))
				)
			      )
			      list_obj
			    )
			  )
			  list_coord_SS
		  )
	)				; Создание списка списков объектов по найденным выборкам
	(setq list_obj_SS_LENGTH (LENGTH list_obj_SS))
					; кол-во объектов в первой выборке

	(setq list_SS (mapcar 'list list_coord_SS list_SS))
					; создание списка типа (((коорд_выборки_1)(объекты_этой_выборки_1))((коорд_выборки_2)(объекты_этой_выборки_2))...)

	(setq list_SS
	       (VL-REMOVE-IF
		 (FUNCTION
		   (LAMBDA (i) (< (LENGTH (cadr i)) list_obj_SS_LENGTH))
		 )
		 list_SS
	       )
	)				; отфильтровываем выборки в которых элементов меньше, чем в первой

	(setq list_boxes_SS
	       (_apel-BoundingBox_abs->box_otn
		 (car list_pt_1)
		 list_obj_SS
	       )
	)				;список отн. координат габаритов объектов первой выборки

	(setq list_SS
	       (mapcar (FUNCTION
			 (lambda (i / a b)
			   (list (setq a (caar i))
				 (setq b (cadr i))
				 (_apel-BoundingBox_abs->box_otn a b)
			   )
			 )
		       )
		       list_SS
	       )
	)				; список  типа (((коорд_выборки_1)(объекты_этой_выборки_1)(отн_габариты_объектов_выборки))...)

	(setq list_SS
	       (mapcar
		 (FUNCTION
		   (lambda (c)
		     (list
		       (car c)
		       (vl-remove-if
			 'null
			 (mapcar
			   (function (LAMBDA (a b) (cond (a b))))
			   (mapcar
			     (FUNCTION
			       (lambda (b)
				 (apply	'or
					(mapcar	(FUNCTION (lambda (i)
							    (equal i b 0.001)
							  )
						)
						list_boxes_SS
					)
				 )
			       )
			     )
			     (caddr c)
			   )
			   (cadr c)
			 )
		       )
		     )
		   )
		 )
		 list_SS
	       )
	)				; список  типа (((коорд_выборки_1)(объекты_этой_выборки_1_но только те, что соответствуют)...)
	(setq
	  list_SS (vl-remove-if
		    (FUNCTION
		      (LAMBDA (i)
			(< (LENGTH (cadr i)) list_obj_SS_LENGTH)
		      )
		    )
		    list_SS
		  )
	)				; Отфильтровываем выборки в которых совпавших объектов меньше, чем в исходной
;;;	В результате получили список выборок в которых есть объекты полностью соответствующие, и эти объекты даны списком
	(while (null blk_obj)
	  (setq	N (cond	(N (1+ N))
			(1)
		  )
	  )
	  (setq
	    blk_obj (apel-block-add_document
		      (strcat "apel-draw-find_analog_objects_"
			      (rtos (apel_rand) 2 0)
			      (rtos N 2 0)
		      )
		    )
	  )
	)				; Создаем пустой блок с оригинальным именем


	(setq p1 (APEL-POINT-LIST_TO_VARIANT (car list_pt_1))
	      p2 (APEL-POINT-LIST_TO_VARIANT (list 0.0 0.0 0.0))
	)

	(mapcar	(FUNCTION
		  (LAMBDA (i)
		    (vla-move i
			      p1
			      p2
		    )
		  )
		)
		(APEL-POINT-VARIANT_TO_LIST
		  (vla-copyobjects
		    (APEL-ACTIVE_DOCUMENT)
		    (vlax-make-variant
		      (vlax-safearray-fill
			(vlax-make-safearray
			  vlax-vbobject
			  (cons 0 (1- (length list_obj_SS)))
			)
			list_obj_SS
		      )
		    )
		    blk_obj
		  )
		)
	)				;Создание блока с элементами из первой выборки
	(setq list_blocks
	       (mapcar (FUNCTION (LAMBDA (i)
				   (APEL-BLOCK-INSERT
				     (APEL-MOD-GET_PROPERTY blk_obj 'Name)
				     (APEL-POINT-LIST_TO_VARIANT i)
				     1
				     1
				     1
				     0
				   )
				 )
		       )
		       (mapcar 'car list_SS)
	       )
	)				;Вставляем созданный блок на место найденных выборок
	(mapcar	(FUNCTION (LAMBDA (i) (vla-Highlight i :vlax-true)))
		list_blocks
	)				;Подсвечиваем выбранные блоки


	(mapcar	(FUNCTION APEL-DELETE)
		(apply 'append (mapcar 'cadr list_SS))
	)				;Удаляем объекты из найденных выборок


      )

    (princ (strcat "\n Создано блоков: "
		   (rtos (LENGTH list_blocks) 2 0)
	   )
    )
    (princ "\n Не получилось!")
  )
)

[doslidnik]

Ответ поддержки ToolPac

Thanks for the drawing, we'll get started on it today for inclusion in a near future version of our ToolPac. You could download a BricsCAD 30-day trial, they already have this tool, I believe they call it BLOCKIFY.

----- добавлено через ~1 ч. -----
Спасибо за видео. Супер. Именно то что надо.

Пишу для таких как я (те хто в танке)

Качаем файл apel.fas
Загрузили и команда "(apel-com '(apel-draw-find_analog_objects))"

Файл имеет дохрена полезньіх функций, есть список ТУТ, но описание нет.
А вот и АНАЛОГИЧНАЯ тема https://forum.dwg.ru/showthread.php?t=67242

[doslidnik]

Радости нет предела от найденой програмьі НО, вот такие моментьі (там где блоки развернутьі) программа не решает. Если будет когда нибуть реализация такая, напишите пожалуйста в л/с.


Реализация задачи №2
Вот еще реализация такой задачи по аналогу BLOCKIFY в BricsCAD.
Видео работьі прораммьі ТУТ
Файл vlx под видео или ТУТ


Реализация задачи №3
https://www.cadforum.cz/cadforum_en/...ences-tip12036

----- добавлено через 15 сек. -----
Apelsinov,

[Vov.Ka]

Сообщение от doslidnik Файл vlx под видео или ТУТ

первоисточник https://www.theswamp.org/index.php?topic=55186.0