[Shaft]

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

Значит задача заключается в следующем:
Чтобы при выборе полилинии(ий) (не замкнутой как правило) выделялись все объекты которые она пересекает.

Чувствую, что подобная задача уже когда-то, перед кем-то вставала. И скорее всего уже решение есть.
Но мне пока не удалось его отыскать.

Зато нашел кучу решений в которых на пересечениях

• вставляются вершины
• разрываются объекты
• либо выбираются (но при условии что полилиния является замкутым контуром)

Поделитесь пожалуйста, если кто знает решение моей задачи.

[Nike]

Сообщение от AlexZh Подскажите, а что надо добавить, чтоб не выбирались блоки, у которых линия пересекает ТОЛЬКО атрибут.

Ничего не надо добавлять.
Атрибуты в отдельный слой и при выборе заморозить.

[VVA]

AlexZh, Атрибут - это такой же элемент блока. К посту #41 еще вариант: перед запуском отключить Видимость атрибутов блоков. Потом вернуть обратно. Не проверял, но должно сработать

[AlexZh]

Сообщение от Nike Ничего не надо добавлять. Атрибуты в отдельный слой и при выборе заморозить.

Не слишком мудренно...

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

Сообщение от VVA AlexZh, Атрибут - это такой же элемент блока. К посту #41 еще вариант: перед запуском отключить Видимость атрибутов блоков. Потом вернуть обратно. Не проверял, но должно сработать

Не соглашусь. Может я и ошибаюсь, но блок можно как бы разделить на вхождение блока и атрибут. И когда полилиния пересекает атрибут блока, но не сам блок, ведь можно сделать проверку на это и блок с этим атрибутом в набор не добавлять.

[koMon]

AlexZh,

Сообщение от AlexZh Может я и ошибаюсь

Не ошибаешься!) В качестве альтернативы)

Код:

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

 

;******************************************************************************************************************************************
;
;													     Написал koMon 07.12.2017
;
; 						Использование. Функция (plsect) с командой Автокада (не вызывать из работающего макроса),
; 						которая предлагает выбор объектов. Выбирается полилиния, пересекающая какие-то примитивы,
; 						которые добавляются в текщий набор. Если это блок с атрибутами, то при пересечении только
; 						атрибута(ов) блока, он не добавляется в текущий набор. При выполнении без активной команды
;						создаст и подсветит набор как описано выше. Производится зум аут до видиости всей
;						полилинии с последующим откатом к предыдущему зуму.
;
;******************************************************************************************************************************************

(defun plsect( / acad_Object document_Object crossing_polyline crossing_polyline_object left_lower_corner right_upper_corner
				 pline_crossing_sset_index checked_object intersection_Points_array intersections_number
				 dummy_crossing_polyline_object block_insertion_point_3d origin_3d block_entities_list starting_Entity next_entity
				 block_entities_list block_entities_do_not_intersect_with_polyline block_entities_list_index block_entity_object
				 with_Entity_intersection_Points_array block_not_found_in_selection_set entsel_data entsel_return
			 )
  	(setq acad_Object (vlax-get-acad-object)
  			document_Object (vla-get-ActiveDocument acad_Object)
  			is_selecting_polyline t
			is_zoommed_out nil
  	)
	(while is_selecting_polyline
		(setq entsel_return (type (setq entsel_data (vl-catch-all-apply 'EntSel (list "\nSelect Crossing Polyline or press Esc")))))
		(cond
			(
				(= entsel_return 'LIST)
					(cond
						(
						  	(= (vla-get-objectname (setq crossing_polyline_object (vlax-ename->vla-object (car entsel_data)))) "AcDbPolyline")
								(setq is_selecting_polyline nil)
						)
							(
								t
							)
					)
			)
			(
				(= entsel_return 'VL-CATCH-ALL-APPLY-ERROR)
					(setq is_selecting_polyline nil)
					(setq pline_crossing_sset (ssadd))
					(princ "\nCrossing Polyline Selecting is Cancelled! ")
			)
			(
				t
			)
		)
	)
  	(if crossing_polyline_object
  		(progn
  			(vla-GetBoundingBox crossing_polyline_object 'left_lower_corner 'right_upper_corner)
			(vla-ZoomWindow acad_Object left_lower_corner right_upper_corner)
  			(setq pline_crossing_sset (ssget "_C" (vlax-safearray->list left_lower_corner) (vlax-safearray->list right_upper_corner))
  			      pline_crossing_sset (ssdel (car entsel_data) pline_crossing_sset)
  				  pline_crossing_sset_index 0
				  is_zoommed_out t
  			)
  		)
	)
	(setq block_not_found_in_selection_set t)
  	(repeat (sslength pline_crossing_sset)
  		(setq checked_object (vlax-ename->vla-object (setq checked_entity (ssname pline_crossing_sset pline_crossing_sset_index)))
  			  intersection_Points_array (vl-catch-all-apply 'vla-IntersectWith (list crossing_polyline_object checked_object acExtendNone))
  		)
  		(if (or (= (type intersection_Points_array) 'VL-CATCH-ALL-APPLY-ERROR)
				(< (setq intersections_number (vlax-safearray-get-u-bound (vlax-variant-value intersection_Points_array) 1)) 0)
			)
  			(setq pline_crossing_sset (ssdel checked_entity pline_crossing_sset))								;entity does not intersect with crossing polyline or reports an error
  			(cond                                                                                               ;entity does intersect with crossing polyline
				(
					(vlax-property-available-p checked_object 'path)                                            ;external reference?
						(setq pline_crossing_sset (ssdel checked_entity pline_crossing_sset))
				)
				(
  			   		(= (vla-get-objectname checked_object) "AcDbBlockReference")
  						(if block_not_found_in_selection_set
  							(progn
  								(setq block_not_found_in_selection_set nil
  									  dummy_crossing_polyline_object (vla-Copy crossing_polyline_object)
  								)
  								(vla-put-Visible dummy_crossing_polyline_object :vlax-false)
  							)
  						)
  						(setq block_insertion_point_3d (vla-get-insertionpoint checked_object)
  							  origin_3d (vlax-3d-point 0 0 0)
  							  block_entities_list '()
  						      starting_Entity (tblobjname "block" (vla-get-Name checked_object))
  						)
  						(vla-Move dummy_crossing_polyline_object block_insertion_point_3d origin_3d)

  						(while (setq next_entity (entnext starting_Entity))
  							(if (and
									(if (= "AcDbHatch" (vla-get-objectname (vlax-ename->vla-object next_entity))) (/= "SOLID" (vla-get-PatternName (vlax-ename->vla-object next_entity))) t)	;hatch with SOLID pattern
									(/= "AcDbAttributeDefinition" (vla-get-objectname (vlax-ename->vla-object next_entity)))
  									(= :vlax-true (vla-get-visible (vlax-ename->vla-object next_entity)))		;visibility of entities in dynamic blocks
  								)
  									(setq block_entities_list (cons next_entity block_entities_list))
  							)
  							(setq starting_entity next_entity)
  						)
  						(setq block_entities_do_not_intersect_with_polyline t
  							  block_entities_list_index 0
  						)
  						(while (and block_entities_do_not_intersect_with_polyline (< block_entities_list_index (length block_entities_list)))
  							(setq block_entity_object (vlax-ename->vla-object (nth block_entities_list_index block_entities_list))
  								  with_Entity_intersection_Points_array (vla-IntersectWith dummy_crossing_polyline_object block_entity_object acExtendNone)
  							)
  							(if (> (vlax-safearray-get-u-bound (vlax-variant-value with_Entity_intersection_Points_array) 1) 0)
  								(setq block_entities_do_not_intersect_with_polyline (and block_entities_do_not_intersect_with_polyline nil))
  							)
  							(setq block_entities_list_index (1+ block_entities_list_index))
  						)
  						(vla-Move dummy_crossing_polyline_object origin_3d block_insertion_point_3d)            ;move dummy polyline back home
  						(if block_entities_do_not_intersect_with_polyline
  							(setq pline_crossing_sset (ssdel checked_entity pline_crossing_sset))				;delete entity from pline_crossing_sset if no entity intersects with dummy polyline
  							(setq pline_crossing_sset_index (1+ pline_crossing_sset_index))						;set index to get next entity in pline_crossing_sset
  						)
  				)
  				(
  					t
  						(setq pline_crossing_sset_index (1+ pline_crossing_sset_index))							;set index to get next entity in pline_crossing_sset
  				)
  			)
  		)
  	)
  	(if (not block_not_found_in_selection_set)
  		(progn
  			(vla-erase dummy_crossing_polyline_object)
  			(vlax-release-object dummy_crossing_polyline_object)
  			(setq dummy_crossing_polyline_object nil)
  		)
  	)
  	(if (zerop (getvar "cmdactive"))
		(if (/= (sslength pline_crossing_sset) 0)
  			(progn
				(sssetfirst nil pline_crossing_sset)
				(princ (strcat (itoa (sslength pline_crossing_sset)) " found"))
				(if is_zoommed_out (vla-ZoomPrevious acad_Object))
				(princ)
			)
			(progn
				(princ (strcat (itoa (sslength pline_crossing_sset)) " found"))
				(if is_zoommed_out (vla-ZoomPrevious acad_Object))
				(princ)
			)
		)
		(progn
			(if is_zoommed_out (vla-ZoomPrevious acad_Object))
			pline_crossing_sset
		)
  	)
)

[AlexZh]

Сообщение от koMon Не ошибаешься!) В качестве альтернативы)

Спасибо! Буду пробовать!

[koMon]

AlexZh,

Сообщение от AlexZh Буду пробовать

ОК. Напиши потом что, да как...

[Setvar]

Есть еще одна тонкость. Внешняя ссылка по существу тоже является "INSERT" и может попасть в выбор объектов. Её надо бы отсечь.

[koMon]

Setvar,

Сообщение от Setvar Есть еще одна тонкость. Внешняя ссылка

Да, ты прав. Сейчас у меня при наличии вн. ссылки лисп рушится.
Обновил это и др. мелочи.

[Setvar]

Программа koMon выделяет только видимые на экране объекты, поскольку не производится зуммирование, как у VVA. Если же вывести на экран сразу границы чертежа, то саму полилинию можно и не разглядеть. У меня как раз такой случай. Полилиний с блоками до фига и больше.

[koMon]

Сообщение от Setvar выделяет только видимые на экране объекты

Ну это вообще не проблема) Зум аут/ин добавил.

[Setvar]

Сообщение от koMon Ну это вообще не проблема)

Да какая там проблема. Всего навсего

Код:

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

Команда: ; ошибка: Ошибка Automation. Неприменимо

[koMon]

Setvar,
Не в бровь, а в глаз))) То есть ты говоришь, что выбирается по-прежнему только экран? Я вроде про зум писал...
Ну я думаю с твоей помощью допилю этого влиспа. А какие в dwg объекты присутствуют? На чём-то спотыкается он...

[Setvar]

Да вообще ничего не выбирается. Zoom происходит, а далее вышеприведенное сообщение.

[koMon]

До зума же выбиралось? DWG, в котором не выбирается можешь дать?

[Setvar]

Вот фрагмент чертежа, скопированный из полного с помощью программы VVA.
AutoCAD 2013.

[koMon]

Да, глючит. Буду разбираться.

----- добавлено через ~1 ч. -----
Разобрался я с фрагментом чертежа, скопированным из полного с помощью программы VVA и внёс коррекцию. Выбирает... долговато.. но признаться не ожидал такого ОБЪЁМА. И это только фрагмент)

[Setvar]

Интересное дело. Во фрагменте, полученном из полного чертежа с помощью программы VVA на самом деле 5 полилиний. Но почему-то программа VVA выделяет все полилинии, куда ни ткни. А программа KoMon выделяет как-то дискретно. Так мне показалось.

[koMon]

Секущая полилиния удаляется из набора.

[Setvar]

Вопрос был, собственно, к VVA. Если мы указываем конкретную полилинию, почему другие-то выделяются, как будто мы все выбрали рамкой?
Добавлено.
Все просто: другие выделяются в том случае, если указанная их пересекает.

----- добавлено через ~10 мин. -----
Еще замечание. Если блок находится на дуговом сегменте полилинии, то
программа VVA его не выделяет;
программа koMon выделяет.

[Setvar]

Мой вариант программы:

Код:

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

;;; Выделение блоков, пересекаемой полилинией. 
(defun C:PLINT ( / pli B pmin pmax ssblc lenss spblc n entblc plist)
(setq pli (car (entsel "\nВыберите пересекающую полилинию: ")))
(if (and pli (= (cdr (assoc 0 (entget pli))) "LWPOLYLINE"))
    (progn
    (setq B (vlax-ename->vla-object pli))
    (vla-GetBoundingBox B 'minp 'maxp)
    (setq pmin (vlax-safearray->list minp) pmax (vlax-safearray->list maxp))
    (vl-cmdf "_ZOOM" pmin pmax)
    (setq ssblc (ssget "_C" pmin pmax (list (cons 0 "INSERT"))))
    (if ssblc 
        (progn
        (setq lenss (sslength ssblc) spblc nil spblc (ssadd) n 0)
        (repeat lenss
            (setq entblc (ssname ssblc n))
            (setq plist (vla-IntersectWith (vlax-ename->vla-object pli) (vlax-ename->vla-object entblc) acExtendNone))
            (setq plist (vlax-variant-value plist))
            (if (>= (vlax-safearray-get-u-bound plist 1) (vlax-safearray-get-l-bound plist 1))
;;;            (if (< (vlax-safearray-get-u-bound plist 1) (vlax-safearray-get-l-bound plist 1)) ;;; Выделение непересекающихся оюъектов
                (ssadd entblc spblc)
            ) ; if
            (setq n (+ 1 n))
        ) ; repeat
        (if spblc (progn (sssetfirst spblc spblc) (princ (strcat "\nНайдено " (itoa (sslength spblc)) " блоков."))))
        ) ; progn
    ) ; if
    ) ; progn
    (princ "\nЭто не полилиния.")
) ; if
(princ)
)

Маленький примерчик, в котором ни моя, ни программа VVA, ни программа koMon один и тот же блок в разных местах полилинии то выделяет, то не выделяет. (У VVA, правда, не обрабатываются дуговые сегменты полилинии). Подобная проблема обсуждалась, но как-то криво. Может, сейчас что-то прояснится?