| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Как получить точки пересечения двух полилиний?

Как получить точки пересечения двух полилиний?

Ответ
Поиск в этой теме
Непрочитано 14.07.2009, 22:27
Как получить точки пересечения двух полилиний?
Mozgunov
 
Начинающий проектировщик
 
Санкт-Петербург
Регистрация: 07.02.2008
Сообщений: 443

Как при помощи автолиспа получить массив точек пересечения двух полилиний? Собственно заголовок и являяется вопросом. Подскажите хотя бы напрвление в котором нужно искать. Спасибо!
Просмотров: 13902
 
Непрочитано 15.07.2009, 23:07
#21
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,826


Mozgunov, а запрашиваемые объекты точно пересекаются?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 15.07.2009, 23:11
#22
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


после неудачного результата что выдает каманда (list obj1 obj2)
to крыс - если не пересекаються должно вернуть nil
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Автор темы   Непрочитано 15.07.2009, 23:14
#23
Mozgunov

Начинающий проектировщик
 
Регистрация: 07.02.2008
Санкт-Петербург
Сообщений: 443
<phrase 1=


Да. Точно пересекаются.
_______________________

Дима_ Выдаёт (<Имя объекта: 7efab390> <Имя объекта: 7efab410>), но ошибки нет уже.

Листинг команд:
Код:
[Выделить все]
Команда: *Прервано*
Команда: *Прервано*
Команда: appload poliline.lsp успешно загружено.
Команда: Укажите объектУкажите объект
Команда:
Команда: (list obj1 obj2)
(<Имя объекта: 7efab410> <Имя объекта: 7efab390>)
Миниатюры
Нажмите на изображение для увеличения
Название: poliline.JPG
Просмотров: 98
Размер:	8.4 Кб
ID:	23620  
Вложения
Тип файла: dwg
DWG 2007
poliline.dwg (75.4 Кб, 1635 просмотров)

Последний раз редактировалось Mozgunov, 15.07.2009 в 23:20.
Mozgunov вне форума  
 
Непрочитано 15.07.2009, 23:29
#24
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


Так работает или нет? У меня с твоим файлом работает. что возращает (type intersect)
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Автор темы   Непрочитано 15.07.2009, 23:39
#25
Mozgunov

Начинающий проектировщик
 
Регистрация: 07.02.2008
Санкт-Петербург
Сообщений: 443
<phrase 1=


Выполняется функция но ничего не возвращает. Перезапустил autocad попробовал снова. Вот что получилось:
Код:
[Выделить все]
Команда: appload
poliline.lsp успешно загружено.
Команда: Укажите объектУкажите объект
Команда:
Команда: (type intersect)
SUBR
Команда: !obj1
<Имя объекта: 7efab410>
Команда: !obj2
<Имя объекта: 7efab390>
Извиняюсь за запудривание мозгов Всё работает! Спасибо большое! :
Цитата:
Команда: (intersect obj1 obj2)
((1583.41 1028.29 0.0) (1943.99 1020.82 0.0) (2259.39 1245.07 0.0))
Mozgunov вне форума  
 
Непрочитано 15.07.2009, 23:43
#26
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


приведи лог (intersect obj1 obj2)
p.s. напиши в чем проблема была - вдруг не ты один такой - чтоб другие тоже знали.
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Автор темы   Непрочитано 15.07.2009, 23:53
#27
Mozgunov

Начинающий проектировщик
 
Регистрация: 07.02.2008
Санкт-Петербург
Сообщений: 443
<phrase 1=


Проблема в том что я не умею пользоваться функциями
Если вызывать функцию (intersect obj1 obj2) то возвращается три списка (точки пересечения полилиний)
Я делал так:
Код:
[Выделить все]
(vl-load-com)
(defun intersect (obj1 obj2 / tmp x y)
(setq tmp 
(vlax-variant-value (apply 'vla-intersectwith
(reverse (cons acExtendNone (mapcar 'vlax-ename->vla-object (list obj1 obj2)))))))
(if (> (vlax-safearray-get-u-bound tmp 1) 0)
(vl-remove nil (mapcar '(lambda (z / ret) 
(if y (setq ret (list x y z) x nil y nil) (if x (setq y z) (setq x z))) ret) 
(vlax-safearray->list tmp)))
);end of if
);end of intersect

(setq obj1 (car(entsel "Укажите объект")))
(setq obj2 (car(entsel "Укажите объект")))

(setq rez (intersect obj1 obj2) )
Потом проверял переменную !rez и получал значение nil. Почему в неё не помещается результат выполнения функции?
Mozgunov вне форума  
 
Непрочитано 16.07.2009, 09:30
#28
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,991
<phrase 1= Отправить сообщение для VVA с помощью Skype™


удалено
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 16.07.2009, 13:05
#29
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


(intersect) возращает nil если объекты не пересекаються, (что возращает команда (setq rez (Intersect obj1 obj2)), то и лежит в rez. Проверить можно, например (list rez).
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Автор темы   Непрочитано 17.07.2009, 01:26
#30
Mozgunov

Начинающий проектировщик
 
Регистрация: 07.02.2008
Санкт-Петербург
Сообщений: 443
<phrase 1=


Дима_, Всё работает прекрасно!!! Я проверел вызывав функцию через командную строку () . Я про то, что в том виде в котором я записал скрипт последний результат вычисления это не присваивание переменной rez списка, а что-то другое, вообщем мне ещё разбираться и разбираться, даже с вашей вункцией.... А так всё работает! Большое спасибо за грамотный и своевременный ответ!
Mozgunov вне форума  
 
Непрочитано 17.07.2009, 08:11
#31
Малявка


 
Регистрация: 28.02.2007
Егорьевск Моск.обл.
Сообщений: 206


У меня вот такой код работает (взято отсюда же, с форума):
Код:
[Выделить все]
;Определение точек пересечения двух примитивов

(defun c:int (/ adoc ent1 ent2 int_lst res _kpblc-conv-list-to-3dpoints)

  (defun _kpblc-conv-list-to-3dpoints (lst / res)
                                      ;|
*    Функция конвертации списка чисел в список 3-мерных точек.
*    Параметры вызова:
*	lst	список чисел
*    Примеры вызова:
(_kpblc-conv-list-to-3dpoints '(1 2 3 4 5 6)) ;-> ((1 2 3) (4 5 6))
(_kpblc-conv-list-to-3dpoints '(1 2 3 4 5))   ;-> ((1 2 3) (4 5 0.))
|;
    (cond
      ((not lst)
       nil
       )
      (t
       (setq res (cons (list (car lst)
                             (if (cadr lst)
                               (cadr lst)
                               0.
                               ) ;_ end of if
                             (if (caddr lst)
                               (caddr lst)
                               0.
                               ) ;_ end of if
                             ) ;_ end of list
                       (_kpblc-conv-list-to-3dpoints (cdddr lst))
                       ) ;_ end of cons
             ) ;_ end of setq
       )
      ) ;_ end of cond
    res
    ) ;_ end of defun

  (vl-load-com)
  (if (and (not (vl-catch-all-error-p
                  (vl-catch-all-apply
                    '(lambda ()
                       (setq ent1
                              (car
                                (entsel
                                  "\nУкажите примитив 1 (кроме блока и внешней ссылки) <Отмена> : "
                                  ) ;_ end of entsel
                                ) ;_ end of car
                             ) ;_ end of setq
                       ) ;_ end of lambda
                    ) ;_ end of vl-catch-all-apply
                  ) ;_ end of vl-catch-all-error-p
                ) ;_ end of not
           ent1
           (not (member (cdr (assoc 0 (entget ent1))) '("INSERT")))
           (not (vl-catch-all-error-p
                  (vl-catch-all-apply
                    '(lambda ()
                       (setq ent2
                              (car
                                (entsel
                                  "\nУкажите примитив 2 (кроме блока и внешней ссылки) <Отмена> : "
                                  ) ;_ end of entsel
                                ) ;_ end of car
                             ) ;_ end of setq
                       ) ;_ end of lambda
                    ) ;_ end of vl-catch-all-apply
                  ) ;_ end of vl-catch-all-error-p
                ) ;_ end of not
           ent2
           (not (member (cdr (assoc 0 (entget ent2))) '("INSERT")))
           ) ;_ end of and
    (progn
      (if (> (vlax-safearray-get-u-bound
               (setq int_lst (vlax-variant-value
                               (vla-intersectwith
                                 (vlax-ename->vla-object ent1)
                                 (vlax-ename->vla-object ent2)
                                 acextendnone
                                 ) ;_ end of vla-IntersectWith
                               ) ;_ end of vlax-variant-value
                     ) ;_ end of setq
               1
               ) ;_ end of vlax-safearray-get-u-bound
             ) ;_ end of >
        (setq res (_kpblc-conv-list-to-3dpoints (vlax-safearray->list int_lst)))
        ) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
  res
  ) ;_ end of defun
С полилиниями работает на ура.

Последний раз редактировалось Малявка, 17.07.2009 в 09:15. Причина: Редактирование кода для "читабельности"
Малявка вне форума  
 
Непрочитано 28.05.2012, 15:37
#32
aburvalg


 
Регистрация: 25.02.2012
Сообщений: 4


Цитата:
Сообщение от Дима_ Посмотреть сообщение
Держи:
Код:
[Выделить все]
(defun intersect (obj1 obj2 / tmp x y)
(setq tmp 
(vlax-variant-value (apply 'vla-intersectwith
(reverse (cons acExtendNone (mapcar 'vlax-ename->vla-object (list obj1 obj2)))))))
(if (> (vlax-safearray-get-u-bound tmp 1) 0)
(vl-remove nil (mapcar '(lambda (z / ret) 
(if y (setq ret (list x y z) x nil y nil) (if x (setq y z) (setq x z))) ret) 
(vlax-safearray->list tmp)))
);end of if
);end of intersect
пример: (intersect (entlast) (entnext))
спасибо большое. замечательно всё работает.
aburvalg вне форума  
 
Непрочитано 14.06.2013, 17:33
#33
АлексЮстасу

топограф, технолог
 
Блог
 
Регистрация: 24.05.2009
Москва
Сообщений: 3,031


А если не двух полилиний, а множества полилиний, у которых нужно найти точки пересечения?
В идеале получить либо множество примитивов-точек в точках пересечений, либо вставить блоки в них. Список координат этих точек тоже неплохо.
Offtop: Мне мерещится, что нечто подобное я на форуме уже видел, но найти пока не получается.
АлексЮстасу вне форума  
 
Непрочитано 16.06.2013, 17:31
#34
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,991
<phrase 1= Отправить сообщение для VVA с помощью Skype™


АлексЮстасу, Уточни задачу. Есть набор, состоящий из полилиний. Нужно найти точки пересечения полилиний каждой с каждой? И просто вывести список всех возможных точек? Если несколько полилиний пересекаются в одной точке, то в результирующем списке точка пересечения должна присутствовать только один раз или нет?
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 17.06.2013 в 01:09.
VVA вне форума  
 
Непрочитано 16.06.2013, 21:22
#35
АлексЮстасу

топограф, технолог
 
Блог
 
Регистрация: 24.05.2009
Москва
Сообщений: 3,031


Цитата:
Сообщение от VVA Посмотреть сообщение
АлексЮстасу, Уточни задачу. Есть набор, состоящий из полилиний. Нужно найти точки пересечения полилиний каждой с каждой? И просто вывести список всех возможных точек? Если несколько полилиний пересекаются в одной точке в результирующем списке точка пересечения должна присутствовать только один раз или нет?
Да, все именно так. Или не список координат точек, а сразу примитивы-точки или указанные блоки по одной штуке на одно пересечение, вне зависимости от числа пересекающихся в любой из точек линий.
АлексЮстасу вне форума  
 
Непрочитано 16.06.2013, 22:50
1 | #36
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


не проверяя как-то так -
Код:
[Выделить все]
 (defun all-pt (lst)
  ((lambda (frec) (apply 'append (frec lst)))
   (lambda (lst)
      (if (cdr lst)
	      (cons (apply 'append (mapcar '(lambda (x) (intersect (car lst) x)) (cdr lst)))
		        (frec (cdr lst)))))))
запустить - что-то вроде (all-pt (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget)))))
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 17.06.2013, 01:07
2 | #37
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,991
<phrase 1= Отправить сообщение для VVA с помощью Skype™


3 команды: POLYBLOCK и POLYPOINT и POLYPOINTVX . Об описании блока и режиме отображения точек нужно позаботиться заранее и самостоятельно
Использовал ф-цию all-pt из поста выше. Она рекурсивная. Надеюсь, количество обрабатываемых полилиний будет в разумных для нее (рекурсии) пределах
Отличие POLYPOINT от POLYPOINTVX. POLYPOINT - ставит точки во всех пересечениях полилиний
POLYPOINTVX - не ставит точки в точках общих вершин выбранных полилиний (см. пост #40)

Код:
[Выделить все]
;;Для изменения имени блока ищем строчку ниже
;;  (setq blk "BLK") ;_имя блока для вставки
;;Отличие POLYPOINT от POLYPOINTVX. POLYPOINT - ставит точки во всех пересечениях полилиний
;; POLYPOINTVX - не ставит точки в точках общих вершин выбранных полилиний
;;опубликовано - https://forum.dwg.ru/showpost.php?p=1108065&postcount=37

(vl-load-com)
(defun all-pt (lst)
  ((lambda (frec) (apply 'append (frec lst)))
    (lambda (lst)
      (if (cdr lst)
        (cons
          (apply 'append
                 (mapcar '(lambda (x) (intersect (car lst) x)) (cdr lst))
          ) ;_ end of apply
          (frec (cdr lst))
        ) ;_ end of cons
      ) ;_ end of if
    ) ;_ end of lambda
  )
) ;_ end of defun
(defun intersect (obj1 obj2 / tmp x y)
  (setq tmp
         (vlax-variant-value
           (apply 'vla-intersectwith
                  (reverse
                    (cons acextendnone
                          (mapcar 'vlax-ename->vla-object (list obj1 obj2))
                    ) ;_ end of cons
                  ) ;_ end of reverse
           ) ;_ end of apply
         ) ;_ end of vlax-variant-value
  ) ;_ end of setq
  (if (> (vlax-safearray-get-u-bound tmp 1) 0)
    (vl-remove nil
               (mapcar '(lambda (z / ret)
                          (if y
                            (setq ret (list x y z)
                                  x   nil
                                  y   nil
                            ) ;_ end of setq
                            (if x
                              (setq y z)
                              (setq x z)
                            ) ;_ end of if
                          ) ;_ end of if
                          ret
                        ) ;_ end of lambda
                       (vlax-safearray->list tmp)
               ) ;_ end of mapcar
    ) ;_ end of vl-remove
  )                                               ;end of if
)                                                 ;end of intersect
(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))
    ) ;_ end of setq
  ) ;_ end of while
  (reverse OutList)
) ;_ end of defun
(defun Insert (pt Nme)
  (entmakex (list (cons 0 "INSERT")
                  (cons 2 Nme)
                  (cons 10 pt)
            ) ;_ end of list
  ) ;_ end of entmakex
) ;_ end of defun
(defun Point (pt)
  (entmakex (list (cons 0 "POINT")
                  (cons 10 pt)
            ) ;_ end of list
  ) ;_ end of entmakex
) ;_ end of defun

(defun C:POLYPOINT ()
  (mapcar
    '(lambda (pt)
       (point pt)
     ) ;_ end of lambda
    (mip_MakeUniqueMembersOfList
      (all-pt
        (vl-remove-if
          'listp
          (mapcar
            'cadr
            (ssnamex
              (ssget '((0 . "*POLYLINE")
                      )
              ) ;_ end of ssget
            ) ;_ end of ssnamex
          ) ;_ end of mapcar
        ) ;_ end of vl-remove-if
      ) ;_ end of all-pt
    ) ;_ end of mip_MakeUniqueMembersOfList
  ) ;_ end of mapcar
  (princ)
) ;_ end of defun
(defun C:POLYPOINTVX (/ lst plst)
  (setq lst (vl-remove-if
              'listp
              (mapcar
                'cadr
                (ssnamex
                  (ssget '((0 . "*POLYLINE")
                          )
                  ) ;_ end of ssget
                ) ;_ end of ssnamex
              ) ;_ end of mapcar
            ) ;_ end of vl-remove-if
  ) ;_ end of setq
  (setq plst (mapcar '(lambda (e) (polycoord e)) lst))
  (setq lst (all-pt lst))
  (mapcar
    '(lambda (pt)
       (if pt
         (point pt)
       ) ;_ end of if
     ) ;_ end of lambda
    (mip_MakeUniqueMembersOfList
      (mapcar
        '(lambda (p f)
           (if f
             nil
             p
           ) ;_ end of if
         ) ;_ end of lambda
        lst
        (mapcar
          '(lambda (l1) (apply 'and l1))
          (mapcar
            '(lambda (pt)
               (mapcar
                 '(lambda (x)
                    (vl-remove-if-not '(lambda (a) (equal a pt 1e-6)) x)
                  ) ;_ end of lambda
                 plst
               ) ;_ end of mapcar
             ) ;_ end of lambda
            lst
          ) ;_ end of mapcar
        ) ;_ end of mapcar
      ) ;_ end of mapcar

    ) ;_ end of mip_MakeUniqueMembersOfList
  ) ;_ end of mapcar
  (princ)
) ;_ end of defun
(defun polycoord (en / i l)
  (setq en (vlax-ename->vla-object en))
  (repeat (setq i (fix (1+ (vlax-curve-getendparam en))))
    (setq l
           (cons (trans (vlax-curve-getpointatparam en (setq i (1- i))) 0 1)
                 l
           ) ;_ end of cons
    ) ;_ end of setq
  ) ;_ end of repeat
  l
) ;_ end of defun
(defun C:POLYBLOCK (/ blk)
  (setq blk "BLK") ;_имя блока для вставки
  (mapcar
    '(lambda (pt)
       (Insert pt blk)
     ) ;_ end of lambda
    (mip_MakeUniqueMembersOfList
      (all-pt
        (vl-remove-if
          'listp
          (mapcar
            'cadr
            (ssnamex
              (ssget '((0 . "*POLYLINE")
                      )
              ) ;_ end of ssget
            ) ;_ end of ssnamex
          ) ;_ end of mapcar
        ) ;_ end of vl-remove-if
      ) ;_ end of all-pt
    ) ;_ end of mip_MakeUniqueMembersOfList
  ) ;_ end of mapcar
  (princ)
) ;_ end of defun
(princ "\ntype POLYBLOCK, POLYPOINT or POLYPOINTVX")
(princ)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 31.08.2023 в 18:17.
VVA вне форума  
 
Непрочитано 17.06.2013, 02:04
#38
АлексЮстасу

топограф, технолог
 
Блог
 
Регистрация: 24.05.2009
Москва
Сообщений: 3,031


Цитата:
Сообщение от Дима_ Посмотреть сообщение
не проверяя как-то так -
Код:
запустить - что-то вроде (all-pt (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget)))))
Цитата:
Сообщение от VVA Посмотреть сообщение
2 команды: POLYBLOCK и POLYPOINT. Об описании блока и режиме отображения точек нужно позаботиться заранее и самостоятельно
Использовал ф-цию all-pt из поста выше. Она рекурсивная. Надеюсь, количество обрабатываемых полилиний будет в разумных для нее (рекурсии) пределах
Спасибо!
Пардон за невежество, это лисп?
И как указать, что именно этот блок (если их в файле несколько описано разных)?
Сейчас POLYBLOCK отвечает:
Цитата:
Команда: POLYBLOCK
Выберите объекты: Противоположный угол: найдено: 5
Выберите объекты:
(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil)
А POLYPOINT исправно наставила точек.

Последний раз редактировалось АлексЮстасу, 17.06.2013 в 02:12.
АлексЮстасу вне форума  
 
Непрочитано 17.06.2013, 11:11
1 | #39
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,991
<phrase 1= Отправить сообщение для VVA с помощью Skype™


АлексЮстасу,
Добавил в #37 указание в начало кода.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 30.08.2023, 12:43
#40
Vict0r

Инвентаризация з/у
 
Регистрация: 30.03.2006
Брянск
Сообщений: 20


Цитата:
Сообщение от VVA Посмотреть сообщение
2 команды: POLYBLOCK и POLYPOINT.
Можете как-то поправить, чтобы "point" не ставились в точках общих вершин выбранных полилиний? Только если хотя бы у одной их проверяемых в месте пересечения нет вершины?
Vict0r вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Как получить точки пересечения двух полилиний?

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Тела пересекаются, как нарисовать контур пересечения BM60 AutoCAD 12 08.09.2008 11:09
координаты вершин выбранной полилинии на VB? как получить ssv22 Программирование 5 17.07.2008 00:01
как получить путь к сетевому текстовому файлу Victorovich Программирование 3 30.06.2008 15:47
Объединение двух 3D полилиний Рyslan AutoCAD 12 22.05.2008 13:14