Как выделить объекты пересекаемые полилинией?

Shaft · 13.04.2012, 07:14

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

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

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

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

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

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

koMon · 15.12.2017, 10:19

Цитата:

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

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

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

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

Setvar · 15.12.2017, 11:03

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

Nike · 15.12.2017, 11:44

Setvar, http://opsonline.ru/prog10

Setvar · 15.12.2017, 14:06

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

posetitel · 02.04.2018, 13:26

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

kp+ · 02.04.2018, 16:53

Цитата:

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

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

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

posetitel · 02.04.2018, 17:20

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

Air81 · 07.09.2018, 12:36

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

aafeoktistov · 26.03.2019, 14:47

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

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

VVA · 19.04.2024, 16:51

Цитата:

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

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
как выделить все объекты одного слоя или быстро сделать н...	Валера_	AutoCAD	42	02.08.2022 12:13
Как определить стоимость проектных работ, если не известна стоимость строительства?	dextron3	Поиск литературы, чертежей, моделей и прочих материалов	37	27.08.2014 18:32
Как выделить объекты на слое	Serjik7	AutoCAD	34	16.07.2012 11:37
как выделить определённые объекты vba	dickens	Программирование	12	15.12.2011 15:54
Как программно выделить (подсветить) объекты на текущи чертеже?	Michigan	Программирование	2	26.05.2009 22:09

13.04.2012, 07:14
Как выделить объекты пересекаемые полилинией? Shaft отдел открытых горных работ Новокузнецк Регистрация: 06.05.2009 Сообщений: 124 Всем доброго времени суток и отличного настроения! Значит задача заключается в следующем: Чтобы при выборе полилинии(ий) (не замкнутой как правило) выделялись все объекты которые она пересекает. Чувствую, что подобная задача уже когда-то, перед кем-то вставала. И скорее всего уже решение есть. Но мне пока не удалось его отыскать. Зато нашел кучу решений в которых на пересечениях вставляются вершины разрываются объекты либо выбираются (но при условии что полилиния является замкутым контуром) Поделитесь пожалуйста, если кто знает решение моей задачи. Последний раз редактировалось Shaft, 13.04.2012 в 07:24.
Просмотров: 19830