IntersectWith выдаёт лишние пересечения

Автор Тема: IntersectWith выдаёт лишние пересечения  (Прочитано 211 раз)

0 Пользователей и 1 Гость просматривают эту тему.

Оффлайн GeobuilderАвтор темы

  • ADN Club
  • ***
  • Сообщений: 189
  • Карма: 15
  • Геодезист
  • Skype: Geobuilder
Всем  привет.

В место одной точки находит 3!

Код - Auto/Visual Lisp [Выбрать]
  1. (defun c:test (/ obj_1 obj_2 intersect spc point_list)
  2.   (setq obj_1     (vlax-ename->vla-object (car (entsel)))
  3.         obj_2     (vlax-ename->vla-object (car (entsel)))
  4.         intersect (vlax-safearray->list
  5.                     (vlax-variant-value
  6.                       (vla-intersectWith obj_1 obj_2 acExtendNone)
  7.                     )
  8.                   )
  9.         spc       (vla-get-modelspace
  10.                     (vla-get-activedocument (vlax-get-acad-object))
  11.                   )
  12.   )
  13.   (while (cddr intersect)
  14.     (setq point_list (cons (list (car intersect) (cadr intersect))
  15.                            point_list
  16.                      )
  17.           intersect  (cdddr intersect)
  18.     )
  19.   )
  20.   (mapcar (function (lambda (x)
  21.                       (vla-addpoint spc (vlax-3d-point x))
  22.                     )
  23.           )
  24.           point_list
  25.   )
  26. )
Расстояние между вершинами зелёной полилинии очень маленькое 0,017 ед.чертежа, если её "прополоть" то результат норм получается.


Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 6694
  • Карма: 733
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: IntersectWith выдаёт лишние пересечения
« Ответ #1 : 27-09-2017, 14:36:09 »
Бывает. Увы.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 646
  • Карма: 96
Re: IntersectWith выдаёт лишние пересечения
« Ответ #2 : 27-09-2017, 20:26:35 »
Проблема в очень больших значениях координат. Если переместить полилинии ближе к (0. 0. 0.), то результаты становятся вменяемыми.
Сугубо ИМХО: перед выполнением подобных задач можно получить габаритный контейнер обоих примитивов, переместить их в '(0. 0. 0.), получить точки пересечения, вернуть примитивы на место и преобразовать точки пересечения.
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 646
  • Карма: 96
Re: IntersectWith выдаёт лишние пересечения
« Ответ #3 : 27-09-2017, 20:28:11 »
5 179 км от начала координат - это где такое используется? :)
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 6694
  • Карма: 733
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: IntersectWith выдаёт лишние пересечения
« Ответ #4 : 27-09-2017, 22:39:07 »
5 179 км от начала координат - это где такое используется? :)
Ага.  И при этом расстояние между точками в 10 микрон.

Geobuilder
Вообще-то точность плавающих чисел максимум 16 значащих цифр. Это в идеальном случае если не учитывать потери на математических операциях.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн 1958

  • ADN OPEN
  • Сообщений: 37
  • Карма: 0
Re: IntersectWith выдаёт лишние пересечения
« Ответ #5 : 28-09-2017, 03:44:27 »
5 179 км от начала координат - это где такое используется?
Геодезия, топография, картография, навигация... Нужное подчеркнуть. :)

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 646
  • Карма: 96
Re: IntersectWith выдаёт лишние пересечения
« Ответ #6 : 28-09-2017, 08:10:11 »
Ок. В таком случае мне интересно, откуда в такой области
расстояние между точками в 10 микрон
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн 1958

  • ADN OPEN
  • Сообщений: 37
  • Карма: 0
Re: IntersectWith выдаёт лишние пересечения
« Ответ #7 : 28-09-2017, 12:13:22 »
Ок. В таком случае мне интересно, откуда в такой области
Цитата: Александр Ривилис от 27-09-2017, 22:39:07
расстояние между точками в 10 микрон
А это вопрос к автору темы.

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 6694
  • Карма: 733
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: IntersectWith выдаёт лишние пересечения
« Ответ #8 : 28-09-2017, 12:16:24 »
Ок. В таком случае мне интересно, откуда в такой области
Цитата: Александр Ривилис от 27-09-2017, 22:39:07

    расстояние между точками в 10 микрон


Стыковочный узел космической станции. Хотя и там (IMHO) такая точность не нужна.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн GeobuilderАвтор темы

  • ADN Club
  • ***
  • Сообщений: 189
  • Карма: 15
  • Геодезист
  • Skype: Geobuilder
Re: IntersectWith выдаёт лишние пересечения
« Ответ #9 : 29-09-2017, 06:20:53 »
Всем сапсибо за ответы
Ок. В таком случае мне интересно, откуда в такой области
расстояние между точками в 10 микрон.
Это всё наш любимый Civil 3D  :D и моя приложение Картограмма...
Такая линия с таким количеством вершин это горизонталь из поверхности объёмов, и если в обычных поверхностях микронных связей не бывает, то в поверхности объёмов которая получается из 2-х обычных путём пересечения связей получаются микронные размеры  ;)

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

Про прополку, смотрел всем известную pl:VxRdc из "Новых команд для полилинии" но там столько наворочена, что я даже часть не понял...
Код - Auto/Visual Lisp [Выбрать]
  1. (defun pl:VxRdc ( pl tol / vx lst  n ang i SL dH dS pt1 pt2 pt3 pt4 blg vect Remove vxucs etalon aa newb  change_blg )
  2.   (setq pl (pl:conv-ent-to-ename pl))
  3.   ;;;RUS: Исключаем сглаженные (Fit Spline) полилинии
  4.   ;;;Замечен глюк, что если сразу сгладить полилинию, то
  5.   ;;;dxf группа будет показывать на Polyline, а Объектная модель
  6.   ;;;останется LWPOLYLINE с соответствующим вылетом
  7.   ;;;EN We exclude smoothed (Fit Spline) polylines
  8.   (if (not (member (logand (cdr (assoc 70 (entget pl))) (+ 2 4)) '(2 4)))
  9. (progn
  10.    (setq blg (pl-get-coors&width&bulge pl)
  11.        vx (nth 0 blg)
  12.        s_width (nth 1  blg)
  13.        e_width   (nth 2 blg)
  14.        blg (nth 3 blg)
  15.        )
  16.  
  17. (setq vxucs (mapcar '(lambda(x)(trans x pl 1)) vx))
  18. (setq n 1 len (length vx))
  19. (setq pl (pl:conv-ent-to-vla pl))
  20. (if (zerop (car blg))
  21.   (setq etalon (list (setq pt1 (nth 0 vxucs))
  22.                      (setq pt2 (nth 1 vxucs))
  23.                      (angle pt1 pt2)
  24.                      (last (pl:3d_Wnorm pt1 pt2))
  25.                      )
  26.         n 2
  27.         )
  28.   (setq etalon nil)
  29.   )
  30. (while (< n len)
  31. (grtext -1 (strcat "Вершина № "(itoa n)))
  32.   (cond
  33.     ((equal (nth (1- n) vxucs)
  34.             (nth  n vxucs)
  35.             1e-6
  36.             )
  37.      (setq Remove (cons (1- n) Remove))
  38.      )
  39.        ;;;Дуга
  40.      ((and
  41.         (< n (1- len))
  42.         (not (equal 0.0 (nth n blg) 1e-6))       ;_Current arc vertex
  43.         (not (equal 0.0 (nth (- n 1) blg) 1e-6)) ;_ Previous 1- arc vertex
  44.            (setq pt3 (BulgeCenterRadius
  45.                        (nth (1- n) blg)
  46.                        (trans (vlax-curve-getPointAtParam pl (1- n)) 0 1)
  47.                        (trans (vlax-curve-getPointAtParam pl n) 0 1)
  48.                        )
  49.                  )
  50.            (setq pt4 (BulgeCenterRadius
  51.                        (nth n blg)
  52.                        (trans (vlax-curve-getPointAtParam pl n) 0 1)
  53.                        (trans (vlax-curve-getPointAtParam pl (1+ n)) 0 1)
  54.                        )
  55.                  )
  56.            (equal (car pt3)(car pt4) 1e-6)   ;_Equal Radius
  57.            (equal (cadr pt3)(cadr pt4) 1e-6) ;_Equal center
  58.         )
  59.             (setq etalon nil)
  60.           ;;  combine the arcs
  61.               (setq i (1- n))
  62.               (while (vl-position i Remove)(setq i (1- i))) ;;First not Removed vertex
  63.                (setq pt1 (if (setq aa (assoc i change_blg))
  64.                       (cdr aa)  
  65.                       (nth i blg))
  66.                      )
  67.                (setq aa   (+ (* 4 (atan (abs pt1)))
  68.                              (* 4 (atan (abs (nth n blg)))))
  69.                      newb (tan (/ aa 4.0))
  70.                )
  71.                (if (minusp pt1)
  72.                  (setq newb (- (abs newb)))
  73.                  (setq newb (abs newb))
  74.                )
  75.             (if (setq aa (assoc i change_blg))
  76.               (setq change_blg (subst (cons i newb) aa change_blg))
  77.               (setq change_blg (cons (cons i newb) change_blg)))
  78.             (setq         ;_ blg (pl:subst-i i newb blg)
  79.                   Remove (cons n Remove)
  80.                   )
  81.         )
  82.      ((not (equal 0.0 (nth (- n 1) blg) 1e-6)) ;_ Previous 1- arc vertex
  83.       (setq etalon nil)
  84.       )
  85.      ((equal 0.0 (nth (- n 1) blg) 1e-6) ;_Line
  86.       (if (null etalon)
  87.         (setq etalon (list (setq pt1 (nth (1- n) vxucs))
  88.                      (setq pt2 (nth n vxucs))
  89.                      (angle pt1 pt2)
  90.                      (last (pl:3d_Wnorm pt1 pt2))
  91.                      )
  92.               )
  93.         (progn
  94.           (setq pt1 (nth (1- n) vxucs)
  95.                 pt2 (nth n vxucs)
  96.                 SL (distance pt1 pt2)
  97.                 ang (angle pt1 pt2)
  98.                 vect (last (pl:3d_Wnorm pt1 pt2))
  99.           )
  100.           (if (apply 'equal (list (minusp vect)(minusp (last etalon)))) ;_Совпадают направления
  101.             (progn
  102.               (setq dS (if (< tol 0)(* (sin (abs tol)) SL) tol))
  103.               (setq
  104.                 pt3 (polar pt2 (+ (nth 2 etalon)(* PI 0.5)) 1)
  105.                 pt3 (inters pt2 pt3 (nth 0 etalon)(nth 1 etalon) nil))
  106.               (setq dH (if pt3 (distance pt2 pt3) 1.7e99))
  107.               (if (or
  108.                     (equal pt1 pt2 1e-6) ;_Совпадают вершины
  109.                     (equal dH dS 1e-6)
  110.                     (<= dH dS)           ;_Отклонение
  111.                     )
  112.                
  113.                 (setq Remove (cons (1- n) Remove))    ;_Удаляем n-1 вершину
  114.                 (setq etalon (list (setq pt1 (nth (1- n) vxucs))
  115.                                    (setq pt2 (nth n vxucs))
  116.                                    (angle pt1 pt2)
  117.                                    (last (pl:3d_Wnorm pt1 pt2))
  118.                                    )
  119.                       )
  120.                 )
  121.             )
  122.             (setq etalon (list (setq pt1 (nth (1- n) vxucs))
  123.                                    (setq pt2 (nth n vxucs))
  124.                                    (angle pt1 pt2)
  125.                                    (last (pl:3d_Wnorm pt1 pt2))
  126.                                    )
  127.                       )
  128.         );_if
  129.              
  130.         )
  131.        
  132.       )
  133.      )
  134.      (t nil)
  135.     );_cond
  136.  
  137. (setq n (1+ n))
  138. );_while < n len
  139.  ;;;Обработать совпадания точек начала-конца. Если совпадают, то удалить последнюю и включить флаг замкнутости
  140.   (if (and (> (length vxucs) 3)
  141.         (equal (car vxucs)(last vxucs) 1e-6)
  142.        )
  143.     (progn
  144.     (setq Remove (cons (1- (length vxucs)) Remove))
  145.     (vla-put-Closed pl :vlax-true)
  146.     )
  147.     )
  148.   (setq i '-1 SL nil)
  149.   (if change_blg
  150.   (progn  
  151.   (foreach bl blg
  152.     (if (setq aa (cdr(assoc (setq i (1+ i)) change_blg)))
  153.       (setq SL (cons aa SL))
  154.       (setq SL (cons bl SL))
  155.       )
  156.     )
  157.   (setq blg (reverse SL))
  158.     )
  159.     )
  160.   (if Remove
  161.     (progn
  162.       (setq vx (pl-RemoveNlst Remove vx))
  163.       (setq s_width (pl-RemoveNlst Remove s_width))
  164.       (setq e_width (pl-RemoveNlst Remove e_width))
  165.       (setq blg (pl-RemoveNlst Remove blg))
  166.       (PL-SET-COORS&WIDTH&BULGE pl vx s_width e_width blg)
  167.       )
  168.     )
  169.  
  170.  
  171.   )
  172.     )
  173. (length Remove)
  174.   )
Я так понял там учтено куча вариантов и ситуаций, у меня вроде ситуации одна.
Код - Auto/Visual Lisp [Выбрать]
  1. (setq tol 0.5)
  2. (lambda (a / point_list point)
  3.                                                     (setq
  4.                                                       point_list (groop_by_2
  5.                                                                    (vlax-get
  6.                                                                      a
  7.                                                                      'Coordinates
  8.                                                                    )
  9.                                                                  )
  10.                                                       point      (car point_list)
  11.                                                     )
  12.                                                     (foreach t1
  13.                                                              (cdr
  14.                                                                (reverse
  15.                                                                  (cdr
  16.                                                                    (reverse
  17.                                                                      point_list
  18.                                                                    )
  19.                                                                  )
  20.                                                                )
  21.                                                              )
  22.                                                       (if
  23.                                                         (< (distance point t1)
  24.                                                            tol
  25.                                                         )
  26.                                                          (setq point_list(vl-remove t1
  27.                                                                     point_list
  28.                                                          ))
  29.                                                          (setq point t1)
  30.                                                       )
  31.                                                     )
  32.                                                     (vla-put-coordinates a (Make-Variant point_list))
  33.                                                     a
  34.                                                   )

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 646
  • Карма: 96
Re: IntersectWith выдаёт лишние пересечения
« Ответ #10 : 29-09-2017, 08:20:08 »
Вместо сравнения расстояний можно использовать equal. Насколько я помню, это может быть быстрее и немного проще.
P.S. А код VVA я в свои библиотеки на прошлой работе просто тупо загнал "как есть" - разбираться не стал.
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 6694
  • Карма: 733
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: IntersectWith выдаёт лишние пересечения
« Ответ #11 : 29-09-2017, 08:31:27 »
Как бы тысячи километров + микроны всё равно легко умещаются в 16 значащих цифр...
Это если не учитывать аналитическую геометрию при расчете пересечения линий. Оценить сколько значащих цифр при этом останется в данном случае я сейчас бы не взялся.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение