[Shaft]

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

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

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

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

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

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

[Profan]

Если полилиния состоит только из линейных сегментов, то можно воспользоваться опцией "_fence" ("линия") команды "_select" ("выбрать"), для которой передать определенные программно координаты вершин полилинии.
При разовой задаче можно просто провести выделяющую линию вдоль отрисованной полилинии.

[Shaft]

задача не разовая
про доп.опции комадны "выбрать" (см; рм; л) мне известно и я ими успшно пользуюсь.
но сейчас мне надо выбирать объекты пересекаемые полилинией (а она бывает не только прямой) и я не знаю пока как это можно сделать?

передать определенные программно координаты вершин полилинии

не пойму каким образом это можно сделать, можете разьяснить хотябы в кратце?

[Profan]

Пока могу дать только ссылку:
http://forum.dwg.ru/showthread.php?t=64518

[Shaft]

Эх! Спасибо вам Profan, за ссылку конечно. Но это увы не мой уровень. Т.к. я в програмировании не силен.
Offtop: Пробовал 2 года назад книгу про Lisp почитать. Честно скажу, что я долго мусолил первые две или три главы... но так ничего и не понял. Не знаю, может это не моё? Или просто нужен другой подход для меня

[VVA]

2024-04-19 Новая версия см пост #70


Тестируй
Добавлено *2012-12-02*
2 команды
SELPOLY - Выделение объектов, пересекаемых полилинией
BSELPOLY - Выделение блоков, пересекаемых полилинией
Учтен момент, показанный в #17 (наличие совпадающих вершин в полилинии)

Код:

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

(defun C:SELPOLY ()
  ;;; Выделение объектов, пересекаемых полилинией
  (selpoly nil)
  (princ)
  )
(defun C:BSELPOLY ()
  ;;; Выделение блоков, пересекаемых полилинией
  (selpoly (list(cons 0 "INSERT")))
  (princ)
  )
(defun block-get-name (blkobj)
(cond
  ((and (vlax-property-available-p blkobj 'isdynamicblock)
	(= (vla-get-isdynamicblock blkobj) :vlax-true)
	) ;_ end of and
   (vla-get-effectivename blkobj)
   )
  (t (vla-get-name blkobj))
  ) ;_ end of cond
  )
;| ! *******************************************************************
;; !                  _IsPtInView
;; ! *******************************************************************
;; ! Проверяет находится ли точка в видовом экране
;; ! Auguments: 'pt'  - Точка для анализа в МСК!!!
;; ! Return   : T или nil если 'pt' в видовом экране или нет
;; ! *******************************************************************|;
(defun _get-viewctr-size ( / VCTR Y_Len SSZ X_Pix Y_Pix X_Len)
  (setq VCTR (getvar "VIEWCTR") Y_Len (getvar "VIEWSIZE")
   SSZ (getvar "SCREENSIZE")
   X_Pix (car SSZ) Y_Pix (cadr SSZ)
   X_Len (* (/ X_Pix Y_Pix) Y_Len)
        )
   (list(mapcar '- VCTR (list (* 0.5 X_len)(* 0.5 Y_len)))
        (mapcar '+ VCTR (list (* 0.5 X_len)(* 0.5 Y_len)))
        )
  )
(defun _IsPtInView (pt / Lc Uc)
(setq pt (trans pt 0 1))
(setq Lc (_get-viewctr-size)
      Uc (cadr Lc)
      Lc (car Lc)
      )
  (if (and (> (car pt) (car Lc))(< (car pt) (car Uc))
	 (> (cadr pt) (cadr Lc))(< (cadr pt) (cadr Uc))
         )
	T nil))
;| ! ***************************************************************************
;; !           _pt_extents
;; ! ***************************************************************************
;; ! Function : Возвращает границы MIN, MAX X,Y,Z списка точек
;; ! Argument : 'vlist' - Список точек
;; ! Returns  : Список точек (ЛевНижн ПравВерхн)
;; ! ***************************************************************************|;
(defun  _pt_extents (vlist / tmp)
  (setq tmp (apply 'mapcar (cons 'list vlist)))
  (list (mapcar '(lambda(x)(apply 'min x)) tmp)(mapcar '(lambda(x)(apply 'max x)) tmp)));_defun
  ;; !                             _Zoom2Lst
;; ! **********************************************************
;; ! Function : Zoom границ списка точек
;; ! Arguments: 'vlist' - Список точек в МСК!!!!
;; ! Зуммирует экран, чтобы все точки были видны
;; ! Returns  : t - было зуммирование nil - нет
;; ! **********************************************************
  (defun _Zoom2Lst (vlist / pts)
    (setq pts (_pt_extents (mip:ZZero vlist)))
    (if (not (and (_IsPtInView (car pts)) (_IsPtInView (cadr pts))))
      (progn
        (vla-ZoomWindow (vlax-get-acad-object)(vlax-3d-point (car pts))(vlax-3d-point (cadr pts)))
	(vlax-invoke (vlax-get-acad-object) 'ZoomScaled 0.85 acZoomScaledRelative)
	T
	)
      nil
      )
  ) ;end
(defun mip:entsel (promt filter entlist / key n newentlist ent_point promt)
;;;Функция mip:entsel
;;;Еденичный выбор объекта, замена функции entsel
;;;Возвращает entity name выбранного примитива или nil, точку указания запоминает в переменной LASTPOINT
;;;Параметры:
;;;promt - предложение выбрать объект (string)
;;;filter - фильтр объектов для выбора вида '("LINE" "LWPOLYLINE")
;;;entlist - список примитивов которые не надо выбирать (либо список entity name, либо PICKSET)
;;;
;;;Примеры:
;;;(mip:entsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") nil)
;;;(mip:entsel "\nВыберите объекты" nil nil)
;;;(setq aa nil) (mip:entsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") (while (setq a (car (entsel))) (setq aa (append aa (list a)))))
;;;(mip:entsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") (ssget))
  (setq key T n 0 newentlist nil)
  (if (eq (type entlist) 'PICKSET)
    (progn
    	(while (setq a (ssname entlist n)) (setq newentlist (append newentlist (list a)) n (1+ n)))
    	(setq entlist newentlist)
    );progn
   );if
    (while key
    	(if (or (setq ent_point (entsel promt)) (= (getvar "ERRNO") 7))
	  	(if (or (eq (type ent_point) 'LIST) (not ent_point))
		  (if ent_point
		    (if (member (setq ent (car ent_point)) entlist)
		      (princ "\nПримитив уже выбран")
		      (if filter
			      (if (not (member (cdr (assoc 0 (entget ent))) filter))
				(progn (setq str "\nНе верный выбор, выберите: ")
				  (princ (substr (setq str (foreach n filter (setq str (strcat str n ", ")))) 1 (- (strlen str) 2)))
				);progn
				(setq key nil)
			      );if
				(setq key nil)
			);if
		    );if
		    (setq key T)
		  );if
	    	(setq key nil)
	    );if
	  (setq key nil)
      	);if
     );while
  (if (eq (type ent_point) 'LIST)
    (progn (setvar "LASTPOINT" (cadr ent_point)) ent)
    ent_point
  );if
);defun
  (defun mip_MakeUniqueMembersOfList  ( lst / OutList head)
;;;Удаляет одинаковые (дубликаты) элементы из списка
;;; На основе http://www.theswamp.org/index.php?topic=19128.0
;;; Изменено для сравнения вещественных чисел (equal ... 1e-6)

  (while lst
    (setq head (car lst)
          OutList (cons head OutList)
          lst (vl-remove-if '(lambda(pt)(equal pt head 1e-6))(cdr lst))
          )
    )
  (reverse OutList)
  )
(defun mip:ZZero (lst)
  (mapcar '(lambda(x)(list (car x)(cadr x))) lst)
  )
(defun massoc (key alist / x nlist)
  (foreach x alist
    (if (eq key (car x))
      (setq nlist (cons (cdr x) nlist))
    ))
  (reverse nlist))
(defun SELPOLY ( filter-list / pl lst ss)
;;; Выделение объектов, пересекаемых полилинией
;;; Vladimir Azarko (VVA) for dwg.ru
;;;  filter-list - фильтр список, см. описание ф-ции ssget или nil
;;; http://forum.dwg.ru/showthread.php?t=82243
;;;http://www.cadtutor.net/forum/showthread.php?68857-Counting-objects-not-blocks-in-a-polyline&p=471167#post471167
(vl-load-com)
(and
  (setq pl (mip:entsel "\nВыберите полилинию" '("LWPOLYLINE") nil))
  (setq lst (massoc 10 (entget pl)))
  (or (_Zoom2Lst lst) t)
  (setq ss nil
	ss
	 (if filter-list
	 (ssget
	   "_F"
	   (mip_MakeUniqueMembersOfList
	     (mapcar '(lambda(x)(trans x 0 1)) lst)
	     )
	     filter-list
	     )
	   (ssget
	   "_F"
	   (mip_MakeUniqueMembersOfList
	     (mapcar '(lambda(x)(trans x 0 1)) lst)
	     )
	   )
	   )
	)
  (sssetfirst nil ss)
  )
  ss
  )
(princ "\nНаберите SELPOLY или BSELPOLY в командной строке")

[Shaft]

VVA, вот что выдало в командной строке

Код:

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

Команда: _appload SELPOLY.lsp успешно загружено.


Команда:
Наберите SELPOLY в командной строке
Команда:
Команда: SELPOLY

Выберите полилинию; ошибка: no function definition: MIP:ZZERO

На что конкретно ругается автокад непонятно. Может в коде нужно руками что-то заменить?

[Nike]

Команда: SELPOLY
Выберите полилинию; ошибка: no function definition: MIP:ZZERO

[VVA]

Shaft, Nike, Обновил #6 пробуйте снова

[Shaft]

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

[Nike]

Shaft, у меня все выбирается.
VVA, спасибо!

[Shaft]

Сообщение от Nike Shaft, у меня все выбирается. VVA, спасибо!

Блин, а в чем тогда у меня может быть проблема? Пока не могу найти...

в новом чертеже все работает прекрасно!
а в рабочем не хочет?
Если решение найду, объязательно расскажу.

VVA, БЛАГОДАРЮ ВАС ЗА ПОМОЩЬ В ОЧЕРЕДНОЙ РАЗ!!!

UPD: Решение найдено!
Я повернул чертеж согласно МСК и тогда все сразу же разаботало!!!

[VVA]

Shaft,
Я немного изменил код #6. Попробуй снова. Если ничего не поменяется, то выложи файл с примером

[Danver]

VVA, Спасибо! Хороший лисп. Сохранил себе.

[Агент СмиТ]

Присоединяюсь к поблагодарившим, лисп полезный! Спасибо!

[VVA]

Сообщение от Shaft Я повернул чертеж согласно МСК

Ну да, про ПСК то я совсем забыл . Внес изменения в #6

[beeliy]

спасибо за лисп!
только у меня при работе иногда возникает проблемка такого же плана:

"ничего не происходит после выбора полилинии. Просто экран зумируется до тех пор, чтобы было видно всю полилинию целиком. А выбора объектов под линией не происходит". Не всегда, но бывает.
Файл выкладываю.

[pobat]

Shaft
Здравствуйте!
Скажите пожалуйста, а как можно модифицировать Ваш lsp что вдоль полилинии выделялись не все объекты, а только блоки

[VVA]

Сообщение от pobat как можно модифицировать Ваш lsp что вдоль полилинии выделялись не все объекты, а только блоки

См новый вариант в #6
>Shaft

Блин, а в чем тогда у меня может быть проблема? Пока не могу найти...

>beeliy

"ничего не происходит после выбора полилинии. Просто экран зумируется до тех пор, чтобы было видно всю полилинию целиком. А выбора объектов под линией не происходит". Не всегда, но бывает.

Это происходит из-за того, что в полилинии есть совпадающие вершины. Для функции ssget все точки должны быть уникальные. В частности в примере из #17 в длинной полилинии совпадают 2 и 3 вершина. В новой версии в #6 я учел этот момент

[pobat]

VVA Сердечно благодарю!

[sosococo]

Хороший лисп, но есть некоторые предложения:
- возможность использования для множества полилиний,
- возможность использования лиспа для предварительно выбранных полилиний, или определение полилиний по слою

[AlexZh]

Скажите, а как можно получить список блоков на полилинии. Разобраться знаний не хватает.

[VVA]

Сообщение от AlexZh Скажите, а как можно получить список блоков на полилинии. Разобраться знаний не хватает.

Код:

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

(defun C:BSELPOLYLIST (/ ss)
  (if (setq ss (selpoly (list (cons 0 "INSERT"))))
      (mip_MakeUniqueMembersOfList
        (mapcar 'block-get-name
                (mapcar 'vlax-ename->vla-object
                        (vl-remove-if
                          (function listp)
                          (mapcar (function cadr) (ssnamex ss))
                        ) ;_ end of vl-remove-if
                ) ;_ end of mapcar
        ) ;_ end of mapcar
      ) ;_ end of mip_MakeUniqueMembersOfList
  ) ;_ end of if
) ;_ end of defun

Недостающие функции смотри в #6
PS список блоков=список имен блоков

[AlexZh]

Спасибо!!!

[AlexZh]

А еще подскажите пожалуйста.

Я в своей программе выделяю по полилинии блоки, они подсвечиваются, но и выбираются лишние. Как в программе можно осуществить снятие выбора/добавление объектов?

[АлексЮстасу]

До кучи.
Не знаю с какого времени, но в Express есть для выбора пересекающих объектов команда FS.
Мы, не зная еще про нее, написали свои - PSI_SEL_INTERSECT и PSI_SEL_ON_LINE среди прочего. Наши команды отличаются тем, что можно находить нужное относительно сразу множества полилиний-линий-сплайнов-окружностей-дуг.

Сообщение от AlexZh Я в своей программе выделяю по полилинии блоки, они подсвечиваются, но и выбираются лишние. Как в программе можно осуществить снятие выбора/добавление объектов?

В "своей" - это в какой? Какой критерий лишние/не лишние?

[AlexZh]

Сообщение от АлексЮстасу В "своей" - это в какой? Какой критерий лишние/не лишние?

ну как, в своей?) куча программ, объединенных в одну. проектирую пожарную сигнализацию.


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

[Nike]

Сообщение от AlexZh в одном моменте выбирается шлейф, по которому выбираются извещатели-блоки. но при этом могут захватится и блоки соседние.

Какие соседние? Соседние блоки, не являющиеся извещателями?
Так размещай блоки разного назначения в своих слоях и выбирай с фильтром по слою.
Покажи пример чертежа.

[AlexZh]

чертеж слишком большой.

есть контроллер на 20 шлейфов.
Мне в данный момент нужен 10 шлейф и извещатели на нем
Я выделяю шлейф №10, выделяются и подсвечиваются извещатели на выбранном шлейфе. Программно подсчитывается их кол-во и собираются данные из их атрибутов и т.д.

Но шлейф идет до самого прибора и по пути может пересечь извещатели других шлейфов, которые в данный момент не нужны.

Нужно после выделения шлейфа иметь возможность добавлять/исключать объекты из созданного набора.

[АлексЮстасу]

Сообщение от AlexZh вот хотелось бы, чтобы пользователю после выбора шлейфа предоставлялась возможность с помощью SHIFR снятия выделения с "лишних" блоков и добор недостающих.

Точно с Shift не действует?
У меня, правда, тоже с Shift не всегда действует.
Я не разбирался с этим, но, возможно, в моем случае мешают растры, даже выключенные. Т.е. в файле, где подгружены растры, на указание элемента с Shift мне пишут

Найдено изображений: 1

, и ничего не происходит. С теми же данными, но без растров выделение снимается/добавляется.

Да, сейчас проверил - после полной выгрузки растров Shift начинает действовать для блоков и т.п. Наверное, есть какая-то настройка?

[VVA]

Сообщение от АлексЮстасу У меня, правда, тоже с Shift не всегда действует. Я не разбирался с этим, но, возможно, в моем случае мешают растры, даже выключенные. Т.е. в файле, где подгружены растры, на указание элемента с Shift мне пишут Цитата: Найдено изображений: 1

Это не Автокад, это Raster Design. Shitf+указание точки внутри растра - выбирают его

[АлексЮстасу]

Сообщение от VVA Это не Автокад, это Raster Design. Shitf+указание точки внутри растра - выбирают его

Но у меня нет Raster Design...

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

Сообщение от АлексЮстасу Но у меня нет Raster Design...

По-моему, у тебя то ли Civil, то ли Map3D

[АлексЮстасу]

Civil/Map3D без Raster Design. (Ща узрею еще одну дыру в своем образовании )

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

Если я не ошибаюсь, Civil / Map3D в себе содержат массу вещей, в том числе и для работы с растрами (в частности, использование файлов привязки растров, которые в чистом AutoCAD напрочь игнорируются). Возможно, у тебя такое поведение обусловлено именно "вертикалкой".

[АлексЮстасу]

Да, в Map3D есть вставка растров с учетом параметров привязки. Очень полезная. И штуки 4-5 других возможностей "ни о чем" (с моей точки зрения). Ничего похожего на нормальную специальную работу с растрами не наблюдается. Даже нет элементарного "сохранить как" растр.
Растры же мы всегда выделяли как все - указанием их границ.

[VVA]

Сообщение от АлексЮстасу Растры же мы всегда выделяли как все - указанием их границ

Может Автодеск позаимствовал для растров из RD в Civil/Map?
В RD есть такие настройкаи

[АлексЮстасу]

Сообщение от VVA Может Автодеск позаимствовал для растров из RD в Civil/Map?

А ведь точно! Есть такая настройка в мап-овском Параметры растрового модуля!
(Вот! С Вашей помощью про это окно и настройки узнал )

[sertor]

Сообщение от АлексЮстасу А ведь точно! Есть такая настройка в мап-овском Параметры растрового модуля!

Да, в Civil/Map 3D есть такая опция. Особенно она полезна для выделения растра (при включенной указанной выше галке) и когда граница изображения отключена (IMAGEFRAME ->0)

[AlexZh]

Сообщение от VVA Тестируй Добавлено *2012-12-02* 2 команды SELPOLY - Выделение объектов, пересекаемых полилинией BSELPOLY - Выделение блоков, пересекаемых полилинией Учтен момент, показанный в #17 (наличие совпадающих вершин в полилинии) Код: [Выделить все] (defun C:SELPOLY () ;;; Выделение объектов, пересекаемых полилинией (selpoly nil) (princ) ) (defun C:BSELPOLY () ;;; Выделение блоков, пересекаемых полилинией (selpoly (list(cons 0 "INSERT"))) (princ) ) (defun block-get-name (blkobj) (cond ((and (vlax-property-available-p blkobj 'isdynamicblock) (= (vla-get-isdynamicblock blkobj) :vlax-true) ) ;_ end of and (vla-get-effectivename blkobj) ) (t (vla-get-name blkobj)) ) ;_ end of cond ) ;| ! ******************************************************************* ;; ! _IsPtInView ;; ! ******************************************************************* ;; ! Проверяет находится ли точка в видовом экране ;; ! Auguments: 'pt' - Точка для анализа в МСК!!! ;; ! Return : T или nil если 'pt' в видовом экране или нет ;; ! *******************************************************************|; (defun _get-viewctr-size ( / VCTR Y_Len SSZ X_Pix Y_Pix X_Len) (setq VCTR (getvar "VIEWCTR") Y_Len (getvar "VIEWSIZE") SSZ (getvar "SCREENSIZE") X_Pix (car SSZ) Y_Pix (cadr SSZ) X_Len (* (/ X_Pix Y_Pix) Y_Len) ) (list(mapcar '- VCTR (list (* 0.5 X_len)(* 0.5 Y_len))) (mapcar '+ VCTR (list (* 0.5 X_len)(* 0.5 Y_len))) ) ) (defun _IsPtInView (pt / Lc Uc) (setq pt (trans pt 0 1)) (setq Lc (_get-viewctr-size) Uc (cadr Lc) Lc (car Lc) ) (if (and (> (car pt) (car Lc))(< (car pt) (car Uc)) (> (cadr pt) (cadr Lc))(< (cadr pt) (cadr Uc)) ) T nil)) ;| ! *************************************************************************** ;; ! _pt_extents ;; ! *************************************************************************** ;; ! Function : Возвращает границы MIN, MAX X,Y,Z списка точек ;; ! Argument : 'vlist' - Список точек ;; ! Returns : Список точек (ЛевНижн ПравВерхн) ;; ! ***************************************************************************|; (defun _pt_extents (vlist / tmp) (setq tmp (apply 'mapcar (cons 'list vlist))) (list (mapcar '(lambda(x)(apply 'min x)) tmp)(mapcar '(lambda(x)(apply 'max x)) tmp)));_defun ;; ! _Zoom2Lst ;; ! ********************************************************** ;; ! Function : Zoom границ списка точек ;; ! Arguments: 'vlist' - Список точек в МСК!!!! ;; ! Зуммирует экран, чтобы все точки были видны ;; ! Returns : t - было зуммирование nil - нет ;; ! ********************************************************** (defun _Zoom2Lst (vlist / pts) (setq pts (_pt_extents (mip:ZZero vlist))) (if (not (and (_IsPtInView (car pts)) (_IsPtInView (cadr pts)))) (progn (vla-ZoomWindow (vlax-get-acad-object)(vlax-3d-point (car pts))(vlax-3d-point (cadr pts))) (vlax-invoke (vlax-get-acad-object) 'ZoomScaled 0.85 acZoomScaledRelative) T ) nil ) ) ;end (defun mip:entsel (promt filter entlist / key n newentlist ent_point promt) ;;;Функция mip:entsel ;;;Еденичный выбор объекта, замена функции entsel ;;;Возвращает entity name выбранного примитива или nil, точку указания запоминает в переменной LASTPOINT ;;;Параметры: ;;;promt - предложение выбрать объект (string) ;;;filter - фильтр объектов для выбора вида '("LINE" "LWPOLYLINE") ;;;entlist - список примитивов которые не надо выбирать (либо список entity name, либо PICKSET) ;;; ;;;Примеры: ;;;(mip:entsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") nil) ;;;(mip:entsel "\nВыберите объекты" nil nil) ;;;(setq aa nil) (mip:entsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") (while (setq a (car (entsel))) (setq aa (append aa (list a))))) ;;;(mip:entsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") (ssget)) (setq key T n 0 newentlist nil) (if (eq (type entlist) 'PICKSET) (progn (while (setq a (ssname entlist n)) (setq newentlist (append newentlist (list a)) n (1+ n))) (setq entlist newentlist) );progn );if (while key (if (or (setq ent_point (entsel promt)) (= (getvar "ERRNO") 7)) (if (or (eq (type ent_point) 'LIST) (not ent_point)) (if ent_point (if (member (setq ent (car ent_point)) entlist) (princ "\nПримитив уже выбран") (if filter (if (not (member (cdr (assoc 0 (entget ent))) filter)) (progn (setq str "\nНе верный выбор, выберите: ") (princ (substr (setq str (foreach n filter (setq str (strcat str n ", ")))) 1 (- (strlen str) 2))) );progn (setq key nil) );if (setq key nil) );if );if (setq key T) );if (setq key nil) );if (setq key nil) );if );while (if (eq (type ent_point) 'LIST) (progn (setvar "LASTPOINT" (cadr ent_point)) ent) ent_point );if );defun (defun mip_MakeUniqueMembersOfList ( lst / OutList head) ;;;Удаляет одинаковые (дубликаты) элементы из списка ;;; На основе http://www.theswamp.org/index.php?topic=19128.0 ;;; Изменено для сравнения вещественных чисел (equal ... 1e-6) (while lst (setq head (car lst) OutList (cons head OutList) lst (vl-remove-if '(lambda(pt)(equal pt head 1e-6))(cdr lst)) ) ) (reverse OutList) ) (defun mip:ZZero (lst) (mapcar '(lambda(x)(list (car x)(cadr x))) lst) ) (defun massoc (key alist / x nlist) (foreach x alist (if (eq key (car x)) (setq nlist (cons (cdr x) nlist)) )) (reverse nlist)) (defun SELPOLY ( filter-list / pl lst ss) ;;; Выделение объектов, пересекаемых полилинией ;;; Vladimir Azarko (VVA) for dwg.ru ;;; filter-list - фильтр список, см. описание ф-ции ssget или nil ;;; http://forum.dwg.ru/showthread.php?t=82243 ;;;http://www.cadtutor.net/forum/showthread.php?68857-Counting-objects-not-blocks-in-a-polyline&p=471167#post471167 (vl-load-com) (and (setq pl (mip:entsel "\nВыберите полилинию" '("LWPOLYLINE") nil)) (setq lst (massoc 10 (entget pl))) (or (_Zoom2Lst lst) t) (setq ss nil ss (if filter-list (ssget "_F" (mip_MakeUniqueMembersOfList (mapcar '(lambda(x)(trans x 0 1)) lst) ) filter-list ) (ssget "_F" (mip_MakeUniqueMembersOfList (mapcar '(lambda(x)(trans x 0 1)) lst) ) ) ) ) (sssetfirst nil ss) ) ss ) (princ "\nНаберите SELPOLY или BSELPOLY в командной строке")

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

[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, правда, не обрабатываются дуговые сегменты полилинии). Подобная проблема обсуждалась, но как-то криво. Может, сейчас что-то прояснится?

[koMon]

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

По ходу тема не интересна никому, кроме...
Лично я написал код, чтобы помочь AlexZh, ну и в целях саморазвития разумеется так же) Личного применения его для себя я не вижу, да и вряд ли когда увижу, хотя х/з. Код VVA построен на принципе выбора объектов методом Fence, точки которого составляют вершины полилинии, соответственноо при наличии дуговых сегментов в секущей полилинии, Fence на них просто забьёт. Я решил использовать метод IntersectWith, который даёт 100% пересечение каждого объекта автокада, за исключением двух с секущей полилинией. Этим подход и хорош, но если приходится молотить большое количество объектов, да и ещё имея в виду пожелание AlexZh, то становится как-то тоскливо, но опять же если важен результат, то в принципе можно и подождать)))
В качесте продолжения тестирования предлагаю дополненный маленький пример так сказать в продолжение.

Кстати в маленьком примере мой код выбирает все блоки на постоянной основе, пробовал несколько раз, хотя код был корректирован местно, сейчас обновлю и глобально.

[Setvar]

Эта программа - только часть предполагаемого набора программ для попытки преобразования плана трасс пожарных извещателей в структурную схему. Не знаю, что получится. На одном из этапов надо нумеровать извещатели с префиксами и с суффиксами из того набора который формируется текущей программой. Релейный адресный блок иногда не пересекается полилинией, но если в нем убрать какой-нибудь объект, то он начинает пересекаться. Дуговой сегмент вряд ли будет использоваться для размещения извещателей, пример для отладки программы сделан. Моя программа получилась значительно проще. Работает, конечно, не моментально, но это понятно при количестве извещателей, измеряемом сотнями.

[Nike]

Setvar, http://opsonline.ru/prog10

[Setvar]

Nike, спасибо, но там ведь платные программы. И тема текущая не про нумерацию извещателй, а про выделение объектов, пересекаемых полилинией. Нумерация еще впереди.

[posetitel]

Скажите, а есть ли возможность доработать лисп, чтобы можно было найти блоки, которые пересекают конкретные полилинии и все это экспортировать в эксель?
Т.е. есть полилинии, каждая на своем слое, например ПЛ_1, ПЛ_2, ПЛ_3 и т.д.
Есть блоки на слое "Блок", у каждого блока или атрибут свой, или имя
Нужно получить таблицу в экселе с указанием какой блок какие полилинии пересекает (или наоборот какие полилинии пересекают какие блоки)

[kp+]

Сообщение от posetitel Т.е. есть полилинии, каждая на своем слое, например ПЛ_1, ПЛ_2, ПЛ_3 и т.д.

Если полилиний не сильно много (ненамного больше 3,5 штук) - то несколько повторных применений BSELPOLY и извлечения данных по их результатам решают вопрос. Если же счет идет на пл_9000, Пл_100500, ПЛ_до_фига, ПЛ_до_фига_и_больше - тогда да, надо дорабатывать LISP.

[posetitel]

речь именно про дофига ПЛ

[Air81]

Люди добрые! Подскажите, не появился ли lisp под 2015 Autocad, позволяющий выбирать блоки (на полилинии) при выборе нескольких полилиний сразу?

[aafeoktistov]

Господа! возник вопрос на основе данной темы.

Подскажите как выбрать блок с определенным названием на линии нужного цвета (LINE - не поли). С помощью лисп. Заранее спасибо!

[VVA]

Сообщение от sosococo Хороший лисп, но есть некоторые предложения: - возможность использования для множества полилиний, - возможность использования лиспа для предварительно выбранных полилиний, или определение полилиний по слою

Реализовал пока на основе кода из поста #6
- возможность использования для множества полилиний,
- возможность использования лиспа для предварительно выбранных полилиний

Код:

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

(defun C:SELPOLY ()
  ;;; Выделение объектов, пересекаемых полилинией
;;;- возможность использования для множества полилиний,
;;;- возможность использования лиспа для предварительно выбранных полилиний
  (selpoly nil)
  (princ)
  )
(defun C:BSELPOLY ()
  ;;; Выделение блоков, пересекаемых полилинией
  (selpoly (list(cons 0 "INSERT")))
  (princ)
  )
(defun block-get-name (blkobj)
(cond
  ((and (vlax-property-available-p blkobj 'isdynamicblock)
	(= (vla-get-isdynamicblock blkobj) :vlax-true)
	) ;_ end of and
   (vla-get-effectivename blkobj)
   )
  (t (vla-get-name blkobj))
  ) ;_ end of cond
  )
;| ! *******************************************************************
;; !                  _IsPtInView
;; ! *******************************************************************
;; ! Проверяет находится ли точка в видовом экране
;; ! Auguments: 'pt'  - Точка для анализа в МСК!!!
;; ! Return   : T или nil если 'pt' в видовом экране или нет
;; ! *******************************************************************|;
(defun _get-viewctr-size ( / VCTR Y_Len SSZ X_Pix Y_Pix X_Len)
  (setq VCTR (getvar "VIEWCTR") Y_Len (getvar "VIEWSIZE")
   SSZ (getvar "SCREENSIZE")
   X_Pix (car SSZ) Y_Pix (cadr SSZ)
   X_Len (* (/ X_Pix Y_Pix) Y_Len)
        )
   (list(mapcar '- VCTR (list (* 0.5 X_len)(* 0.5 Y_len)))
        (mapcar '+ VCTR (list (* 0.5 X_len)(* 0.5 Y_len)))
        )
  )
(defun _IsPtInView (pt / Lc Uc)
(setq pt (trans pt 0 1))
(setq Lc (_get-viewctr-size)
      Uc (cadr Lc)
      Lc (car Lc)
      )
  (if (and (> (car pt) (car Lc))(< (car pt) (car Uc))
	 (> (cadr pt) (cadr Lc))(< (cadr pt) (cadr Uc))
         )
	T nil))
;| ! ***************************************************************************
;; !           _pt_extents
;; ! ***************************************************************************
;; ! Function : Возвращает границы MIN, MAX X,Y,Z списка точек
;; ! Argument : 'vlist' - Список точек
;; ! Returns  : Список точек (ЛевНижн ПравВерхн)
;; ! ***************************************************************************|;
(defun  _pt_extents (vlist / tmp)
  (setq tmp (apply 'mapcar (cons 'list vlist)))
  (list (mapcar '(lambda(x)(apply 'min x)) tmp)(mapcar '(lambda(x)(apply 'max x)) tmp)));_defun
  ;; !                             _Zoom2Lst
;; ! **********************************************************
;; ! Function : Zoom границ списка точек
;; ! Arguments: 'vlist' - Список точек в МСК!!!!
;; ! Зуммирует экран, чтобы все точки были видны
;; ! Returns  : t - было зуммирование nil - нет
;; ! **********************************************************
  (defun _Zoom2Lst (vlist / pts)
    (setq pts (_pt_extents (mip:ZZero vlist)))
    (if (not (and (_IsPtInView (car pts)) (_IsPtInView (cadr pts))))
      (progn
        (vla-ZoomWindow (vlax-get-acad-object)(vlax-3d-point (car pts))(vlax-3d-point (cadr pts)))
	(vlax-invoke (vlax-get-acad-object) 'ZoomScaled 0.85 acZoomScaledRelative)
	T
	)
      nil
      )
  ) ;end
(defun mip-ssentget-by-type (msg types bits / sel cmd_lst)
;;; ssget      
;;; старая mip_get_entt и mip:entsel
;;; Параметры: 
;;; msg - краткое приглашение для выбора, допускается NIL 
;;; bits - целое от 0 до 15, битовый переключатель, значения битов: 
;;;    1 - разрешение выбора на заблокированном слое 
;;;    2 - разрешение многократного выбора 
;;;    4 - разрешение выбора рамкой / секрамкой 
;;;    8 - возвращать набор 
;;; types - список имен допустимых типов примитивов, допускается NIL 
;;; 
;;; Пример: 
;;; (mip-ssentget-by-type "Выбери отрезок или полилинию" '("LINE" "LWPOLYLINE") 14) 
;;;  
;;; Возвращает имя _первого_ примитива из попавших в набор, при удачном выборе 
;;; или NIL при отказе с помощью Enter или прерывании по Esc, в последнем случае, 
;;; одновременно выводит сообщение о прерывании в командную строку. 
;;; 
;;; При наличииии любого из битов: 2, 4 или 8 и при успешном выборе, возвращает 
;;; не имя примитива, а набор. 
;;; 
      (setq msg (strcat "\n"
                  (if msg
                    (strcat msg " ")
                    ""
                  )
                  (if (= (strcase (getvar "SYSCODEPAGE")) "ANSI_1251")
                    "<Выход>"
                    "<Exit>"
                  )
                )
        cmd_lst (if (= (logand bits 2) 0)
                  ":S"
                  ""
                )
        cmd_lst (if (= (logand bits 4) 0)
                  (strcat cmd_lst ":E")
                  cmd_lst
                )
        cmd_lst (if (= (logand bits 1) 0)
                  (strcat cmd_lst ":L")
                  cmd_lst
                )
        cmd_lst (if (/= cmd_lst "")
                  (list (strcat "_" cmd_lst))
                )
        types (mapcar (function (lambda (x) (cons 0 x))) types)
      )
      (if (and types (> (length types) 1))
        (setq types (append (cons '(-4 . "<OR") types) '((-4 . "OR>"))))
      )
      (if types
        (setq cmd_lst (append cmd_lst (list types)))
      )
      (setvar "ERRNO" 0)
      (while (and (/= (getvar "ERRNO") 52) (not sel))
        (princ msg)
        (setvar "nomutt" 1)
        (vl-catch-all-error-p (setq sel (vl-catch-all-apply 'ssget cmd_lst)))
        (setvar "nomutt" 0)
        (if (and (not sel) (= (logand bits 2) 2))
          (setq sel t)
        )
      )
      (cond
        ((not sel) nil)
        ((= (type sel) 'pickset)
          (if (= (logand bits 14) 0)
            (ssname sel 0)
            sel
          )
        )
        ((= (type sel) 'vl-catch-all-apply-error) (princ (vl-catch-all-error-message sel)) nil)
        (t nil)
      )
    )
  (defun mip_MakeUniqueMembersOfList  ( lst / OutList head)
;;;Удаляет одинаковые (дубликаты) элементы из списка
;;; На основе http://www.theswamp.org/index.php?topic=19128.0
;;; Изменено для сравнения вещественных чисел (equal ... 1e-6)

  (while lst
    (setq head (car lst)
          OutList (cons head OutList)
          lst (vl-remove-if '(lambda(pt)(equal pt head 1e-6))(cdr lst))
          )
    )
  (reverse OutList)
  )
(defun mip:ZZero (lst)
  (mapcar '(lambda(x)(list (car x)(cadr x))) lst)
  )
(defun massoc (key alist / x nlist)
  (foreach x alist
    (if (eq key (car x))
      (setq nlist (cons (cdr x) nlist))
    ))
  (reverse nlist))
(defun _dwgru-conv-pickset-to-list (value / lst item)
 ;;; Назначение:
    ;;; Преобразовывает набор (pickset) в обычный список имен примитивов (ename)
    ;;; Низкоуровневая функция. Контроль соответствия типов не производится

    ;;; Параметры: 
    ;;; value - набор (pickset) или nil если пустой набор
    ;;; Возврат:
    ;;;   - список примитивов (Ename)
;;;; Пример
;|
(setq point (vla-addpoint (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3d-point '(0 0 0))))
(_dwgru-conv-pickset-to-list (ssget "_L")) ;_(<Имя объекта: 7ef85e00>)
(_dwgru-conv-pickset-to-list (ssadd)) ;_nil
|;
 (repeat (setq item (sslength value)) ;_ end setq
   (setq lst (cons (ssname value (setq item (1- item))) lst))
 ) ;_ end repeat
lst
)
(defun SELPOLY ( filter-list / lst ss plist flist)
;;; Выделение объектов, пересекаемых полилинией
;;; Vladimir Azarko (VVA) for dwg.ru
;;;  filter-list - фильтр список, см. описание ф-ции ssget или nil
;;; http://forum.dwg.ru/showthread.php?t=82243
;;;http://www.cadtutor.net/forum/showthread.php?68857-Counting-objects-not-blocks-in-a-polyline&p=471167#post471167
(vl-load-com)
(if (setq ss nil ss (ssget "_I" '((0 . "LWPOLYLINE"))))
  (setq plist (_dwgru-conv-pickset-to-list ss))
  (and
     (setq ss (mip-ssentget-by-type "Выбери полилинии" '("LWPOLYLINE") 10))
     (setq plist (_dwgru-conv-pickset-to-list ss))       
     )
  )
 (foreach p plist
   (setq lst (append lst (massoc 10 (entget p))))
   )
   (_Zoom2Lst lst)
  (foreach p plist
    (setq lst (massoc 10 (entget p))) 
   (setq ss nil
	ss
	 (if filter-list
	 (ssget
	   "_F"
	   (mip_MakeUniqueMembersOfList
	     (mapcar '(lambda(x)(trans x 0 1)) lst)
	     )
	     filter-list
	     )
	   (ssget
	   "_F"
	   (mip_MakeUniqueMembersOfList
	     (mapcar '(lambda(x)(trans x 0 1)) lst)
	     )
	   )
	   )
	)
    (setq flist (append flist (_dwgru-conv-pickset-to-list ss)))
   )
  (setq ss nil)
  (if flist
    (progn
      (setq ss nil ss (ssadd))
      (foreach p flist
        (ssadd p ss)
        )
      (sssetfirst nil ss)
      )
    )
  ss
  )
(princ "\nНаберите SELPOLY или BSELPOLY в командной строке")(princ)