Сравнение с допуском

Автор Тема: Сравнение с допуском  (Прочитано 10918 раз)

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

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

  • ADN Club
  • ****
  • Сообщений: 270
  • Карма: 24
  • Геодезист
Сравнение с допуском
« : 16-02-2017, 16:30:07 »
Всем привет!

Первая задача: разбить парные объекты на эти самые пары. Критерием парности была зависимость их координат. Т.е. возле каждой точки на некотором отступе dX и dY находится текст.
Код - Auto/Visual Lisp [Выбрать]
  1. (if (setq
  2.       nabor
  3.        (ssget
  4.          "_:A"
  5.          (list
  6.            (cons 0 "POINT,TEXT")
  7.          )
  8.        )
  9.     )
  10.   (progn
  11.     (setq nabor (mapcar 'vlax-ename->vla-object
  12.                         (vl-remove-if
  13.                           'listp
  14.                           (mapcar 'cadr
  15.                                   (ssnamex nabor)
  16.                           )
  17.                         )
  18.                 )
  19.     )
  20.     (foreach item nabor
  21.       (if (= (vla-get-objectname item) "AcDbText")
  22.         (setq text_list
  23.                (cons
  24.                  (list
  25.                    (3D->2D
  26.                      (vlax-safearray->list
  27.                        (vlax-variant-value
  28.                          (vla-get-InsertionPoint item)
  29.                        )
  30.                      )
  31.                    )
  32.                    item
  33.                  )
  34.                  text_list
  35.                )
  36.         )
  37.         (setq point_list
  38.                (cons
  39.                  (list
  40.                    (3D->2D
  41.                      (vlax-safearray->list
  42.                        (vlax-variant-value
  43.                          (vla-get-coordinates item)
  44.                        )
  45.                      )
  46.                    )
  47.                    item
  48.                  )
  49.                  point_list
  50.                )
  51.         )
  52.       )
  53.     )
  54.     (foreach item point_list
  55.       (setq koord (car item))
  56.       (if (setq text (assoc (list (+ (car koord) d_x)
  57.                                   (+ (cadr koord) d_y)
  58.                             )
  59.                             text_list
  60.                      )
  61.           )
  62.         (progn
  63.           (setq par_list
  64.                  (cons
  65.                    (list
  66.                      koord
  67.                      (cadr item)
  68.                      (cadr text)
  69.                    )
  70.                    par_list
  71.                  )
  72.           )
  73.           (setq text_list (vl-remove text text_list))
  74.         )
  75.       )
  76.     )
  77.   )
  78. )
Работает очень быстро, но оказалось что у некоторых пар dX и dY имеют незначительно отличаются, и не ловятся assoc'ом  :(

Попробовал округлить координаты, тоже быстро работает,  но и тут нашлись исключения:
при округлении до 0,001 скажем таких чисел 125,5554 и 125,5556 получаем 125,556 и 125,555 :( Т.е. хоть они и рядом но asooc на них опять не проходит

Но есть у нас замечательная функция equal
меняем
Код - Auto/Visual Lisp [Выбрать]
  1. (if (setq       text (assoc (list (+ (car koord) d_x)
  2.                                   (+ (cadr koord) d_y)
  3.                             )
  4.                             text_list
  5.                      )
  6.           )
на
Код - Auto/Visual Lisp [Выбрать]
  1. (if (setq text
  2.                    (car
  3.                      (vl-remove-if
  4.                        'not
  5.                        (mapcar
  6.                          (function
  7.                            (lambda (x)
  8.                              (if
  9.                                (and
  10.                                  (equal (caar x)(+ (car koord) d_x)0.1)
  11.                                  (equal (cadar x)(+ (cadr koord) d_y)0.1)
  12.                                )
  13.                                 x
  14.                              )
  15.                            )
  16.                          )
  17.                          text_list
  18.                        )
  19.                      )
  20.                    )
  21.             )
  22.        
Теперь работает корректно, но долго...

Вопрос: как бы это ускорить?

Вторая задача: сравнить углы, тоже с определённым допуском.
Тут как бы объёмы не большие, equal справляется быстро, но опять, скажем при допуске в 3° имеем между углами 1° и 359°  всего  2° т.е. как бы удовлетворяют условие, но естественно (equal 1 359 3) вернёт nil
вариант писать:
Код - Auto/Visual Lisp [Выбрать]
  1. (or
  2.         (equal a b 3)
  3.         (equal (+ a 360) b 3)
  4.         (equal a (+ b 360) 3)
  5.       )
Как-то не красиво выглядит...


 

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

  • Administrator
  • *****
  • Сообщений: 1115
  • Карма: 173
Re: Сравнение с допуском
« Ответ #1 : 16-02-2017, 21:09:42 »
По текстам - сразу скажу. Ты сравниваешь точки вставки, забывая про точки выравнивания. А они могут быть совершенно другими. Я когда-то подобное разбирал на autolisp.ru
Про сравнение углов... Сравнивай не углы, а результаты вычисления
(atan (sin ang) (cos ang))Или можно вообще работать через тригонометрию - сравнивать синусы и косинусы ;)
P.S. Только что приехал домой, сейчас попробую нарисовать свой вариант кода. Есть одна идейка, надо проверить (одно "но" - какое максимальное количество примитивов у тебя может быть в наборе? Я к тому, что прокатит рекурсия или нет с ее ограничением в 19 с небольшим тысяч вызовов?).
Все, что сказано - личное мнение.

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

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

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

  • Administrator
  • *****
  • Сообщений: 1115
  • Карма: 173
Re: Сравнение с допуском
« Ответ #2 : 16-02-2017, 23:17:53 »
Во, как вариант, даже без рекурсии обошелся:
Код - Auto/Visual Lisp [Выбрать]
  1. (defun test2 (dx dy / selset pt_lst txt_lst prec res tmp_pt tmp_txt)
  2.   (if (setq selset (ssget "_A" '((0 . "POINT,TEXT"))))
  3.     (progn (setq selset  ((lambda (/ tab item)
  4.                             (repeat (setq tab  nil
  5.                                           item (sslength selset)
  6.                                           ) ;_ end setq
  7.                               (setq tab (cons (ssname selset (setq item (1- item))) tab))
  8.                               ) ;_ end of repeat
  9.                             ) ;_ end of lambda
  10.                           )
  11.                  pt_lst  (mapcar (function (lambda (x / tmp)
  12.                                              (setq tmp (cdr (assoc 10 (entget x))))
  13.                                              (list (cons "pt" (list (car tmp) (cdr tmp))) (cons "obj" x))
  14.                                              ) ;_ end of lambda
  15.                                            ) ;_ end of function
  16.                                  (vl-remove-if-not (function (lambda (x) (= (cdr (assoc 0 (entget x))) "POINT"))) selset)
  17.                                  ) ;_ end of mapcar
  18.                  txt_lst (mapcar (function (lambda (x / tmp)
  19.                                              (setq tmp (entget x))
  20.                                              (list (cons "pt"
  21.                                                          (if (and (= (cdr (assoc 72 tmp)) 0) (= (cdr (assoc 73 tmp)) 0))
  22.                                                            (cdr (assoc 10 tmp))
  23.                                                            (cdr (assoc 11 tmp))
  24.                                                            ) ;_ end of if
  25.                                                          ) ;_ end of cons
  26.                                                    (cons "obj" x)
  27.                                                    ) ;_ end of list
  28.                                              ) ;_ end of lambda
  29.                                            ) ;_ end of function
  30.                                  (vl-remove-if-not (function (lambda (x) (= (cdr (assoc 0 (entget x))) "TEXT"))) selset)
  31.                                  ) ;_ end of mapcar
  32.                  prec    1e-3
  33.                  ) ;_ end of setq
  34.            (while (and pt_lst
  35.                        txt_lst
  36.                        (setq tmp_pt (car pt_lst))
  37.                        (setq tmp_txt (car (vl-remove-if-not
  38.                                             (function (lambda (x / tmp)
  39.                                                         (setq tmp (cdr (assoc "pt" x)))
  40.                                                         (or (and (equal (car tmp) (cadr (assoc "pt" x)) (+ dx prec))
  41.                                                                  (equal (cadr tmp) (caddr (assoc "pt" x)) prec)
  42.                                                                  ) ;_ end of and
  43.                                                             (and (equal (cadr tmp) (caddr (assoc "pt" x)) (+ dy prec))
  44.                                                                  (equal (car tmp) (cadr (assoc "pt" x)) prec)
  45.                                                                  ) ;_ end of and
  46.                                                             ) ;_ end of or
  47.                                                         ) ;_ end of lambda
  48.                                                       ) ;_ end of function
  49.                                             txt_lst
  50.                                             ) ;_ end of vl-remove-if-not
  51.                                           ) ;_ end of car
  52.                              ) ;_ end of setq
  53.                        ) ;_ end of and
  54.              (setq res     (cons (mapcar '(lambda (x) (cdr (assoc "obj" x))) (list tmp_pt tmp_txt)) res)
  55.                    pt_lst  (vl-remove tmp_pt pt_lst)
  56.                    txt_lst (vl-remove tmp_txt txt_lst)
  57.                    ) ;_ end of setq
  58.              ) ;_ end of while
  59.            ) ;_ end of progn
  60.     ) ;_ end of if
  61.   res
  62.   ) ;_ end of defun
---
Добавлено:
для контроля можно использовать нечто типа
Код - Auto/Visual Lisp [Выбрать]
  1. (defun check (lst / c)
  2. ;; lst - результат выполнения предыдущей функции
  3.   (setq c 0)
  4.   (mapcar '(lambda (x)
  5.              (vla-put-color
  6.                (vlax-ename->vla-object (car x))
  7.                (setq c (if (> c 255)
  8.                          0
  9.                          (1+ c)
  10.                          ) ;_ end of if
  11.                      ) ;_ end of setq
  12.                ) ;_ end of vla-put-color
  13.              (vla-put-color (vlax-ename->vla-object (cadr x)) c)
  14.              ) ;_ end of lambda
  15.           lst
  16.           ) ;_ end of mapcar
  17.   ) ;_ end of defun
P.P.S. Естественно, слои разблокированы и разморожены - по крайней мере, на момент проверки.
Все, что сказано - личное мнение.

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

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

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

  • Administrator
  • *****
  • Сообщений: 1115
  • Карма: 173
Re: Сравнение с допуском
« Ответ #3 : 16-02-2017, 23:19:17 »
Добавлю: когда-то (кажется, на theswamp.org) Евгений Елпанов выкладывал отличную функцию по проверке быстродействия кода. Надо?
Все, что сказано - личное мнение.

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

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

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

  • ADN Club
  • ****
  • Сообщений: 270
  • Карма: 24
  • Геодезист
Re: Сравнение с допуском
« Ответ #4 : 17-02-2017, 05:44:05 »
Спасибо, буду смотреть...
когда-то (кажется, на theswamp.org) Евгений Елпанов выкладывал отличную функцию по проверке быстродействия кода. Надо?
Нет, не нужно, помню про эту функцию, но быстродейственность будем проверять на конкретной задачи.

Оффлайн Дима_

  • ADN Club
  • ****
  • Сообщений: 473
  • Карма: 66
Re: Сравнение с допуском
« Ответ #5 : 17-02-2017, 13:14:12 »
Geobuilder, Алексей Кулик - скажу прямо - при больших объемах данные алгоритмы никуда не годятся (для перебора x пар понадобиться вызовов (x*x+x)/2 функций сравнения). Тут надо применять r-tree, но на автолиспе их реализовывать совсем нет желания, да еще в свзяи с отсутствием лисп-векторов (аналога массивов в "классической терминологии"), реализация будет выглядеть немного "запарной". Но можно например создать индексы по двум осям в виде сбалансированных бинарных деревьев - типа списка из (значение (список меньших) (список больших)) и брать их пересечения. По хорошему - на .net это все реализуется в 20-30 строк (беря готовую реализацию r-tree).
Простым способом на лиспе (но не очень эстетичным) - будет пробежка по чертежу "рамками из ssget" построенными по контурам вокруг искомых точек - будет не очень быстро - но алгоритм будет линейный (то есть на малых данных, где время не значительное он будет безусловно медленней, но с увеличением кол-во пар - когда время становиться ощутимо - рост будет линейным - и значительно более выйгрышным по скорости). Естественно надо будет предварительно "отзумировать" чертеж, и провести прочие манипуляции для корректной работы ssget.

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

  • Administrator
  • *****
  • Сообщений: 13882
  • Карма: 1787
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Сравнение с допуском
« Ответ #6 : 17-02-2017, 14:53:11 »
Естественно надо будет предварительно "отзумировать" чертеж, и провести прочие манипуляции для корректной работы ssget.
Ой! Вот уж чего я советовать никогда бы стал...
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Дима_

  • ADN Club
  • ****
  • Сообщений: 473
  • Карма: 66
Re: Сравнение с допуском
« Ответ #7 : 17-02-2017, 15:48:14 »
Не стали-бы зумировать чертеж или использовать ssget "_CP"? (если мне память не изменяет выбор рамкой - _CP). ИХМО если надо "перебрать" достаточно большой чертеж, а первая часть моего поста про индексацию для реализирующего программиста туманна, то это пожалуй единственный для него способ, на автолисп, заставить отработать алгоритм за разумное время именно через ssget (то есть воспользоваться той-же индексацией на уровне автокада) - иначе выполнение алгоритма легко может растянуться на 15 суток.
Насколько я помню ssget индексация связанна с "программным" экраном, а его "разрешение" действительно никому не известно - в общем наверное есть вероятность "сюрпризов".
з.ы. на всякий случай имею в виду однократное зуммирование по "выбранным габаритам", перед запуском, а не на каждой итерации.

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

  • Administrator
  • *****
  • Сообщений: 13882
  • Карма: 1787
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Сравнение с допуском
« Ответ #8 : 17-02-2017, 17:33:10 »
Не стали-бы зумировать чертеж или использовать ssget "_CP"?
И то и другое.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

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

  • Administrator
  • *****
  • Сообщений: 13882
  • Карма: 1787
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Сравнение с допуском
« Ответ #9 : 17-02-2017, 17:34:31 »
Насколько я помню ssget индексация связанна с "программным" экраном, а его "разрешение" действительно никому не известно - в общем наверное есть вероятность "сюрпризов".
Вот именно это я имею в виду. Не говоря уже о том, что слои должны быть разморожены/включены и т.д.
« Последнее редактирование: 17-02-2017, 19:24:36 от Александр Ривилис »
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

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

  • ADN Club
  • ****
  • Сообщений: 270
  • Карма: 24
  • Геодезист
Re: Сравнение с допуском
« Ответ #10 : 18-02-2017, 11:03:20 »
Простым способом на лиспе (но не очень эстетичным) - будет пробежка по чертежу "рамками из ssget" построенными по контурам вокруг искомых точек
Да, скорее всего так и поступлю, уже когда создавал тут тему, мысль такая мелькнула(вообще когда тему создаешь, пытаешься показать, что ты честно пытался сам разобраться, и пока формулируешь вопрос, свои мысли, иногда сам находишь ответ, я так уже несколько тем, пока писал сам разобрался и не стал их создавать :) )

Вариант Алексея пока не тестил, но на первый взгляд так и не понял, от чего он будет быстрее моего, ведь там тот же самый equal

Ой! Вот уж чего я советовать никогда бы стал...
Александр, а чего бы стали?
Если принять во внимание как нельзя точно описывающие мои навыки программиста, слова Дмитрия
индексацию для реализирующего программиста туманна


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

  • Administrator
  • *****
  • Сообщений: 13882
  • Карма: 1787
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Сравнение с допуском
« Ответ #11 : 18-02-2017, 13:18:50 »
Александр, а чего бы стали?
Воспользовался R-TREE в ObjectARX или .NET. Благо есть уже готовые алгоритмы и даже пре минимальном знании .NET ими можно воспользоваться. Полагаться на (ssget "_C") или (ssget "_CP") я бы не стал. У меня были прецеденты, когда в набор не попадали примитивы, которые должны были туда попасть. В первую очередь это касалось TEXT и MTEXT.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

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

  • ADN Club
  • ****
  • Сообщений: 270
  • Карма: 24
  • Геодезист
Re: Сравнение с допуском
« Ответ #12 : 19-02-2017, 13:58:53 »
и даже пре минимальном знании .NET ими можно воспользоваться.
К сожалению у меня даже не минимальное, а вообще ни какое, а пытался, но ни как не получается :-( Мне даже страшно  становится, на сколько я стал не обучаем, я не плохо знаю AutoCAD, но недавно появилась потребность поработать в 3DMax, думал фигня, он же от Autodesk, разберусь... Но в итоге как баран на новые ворота... вообще ни чего не понятно :-(

Почитал про дерево, и сочинил своё, колхозное-дерево

Код - Auto/Visual Lisp [Выбрать]
  1. ;;;
  2. ;;;round_point
  3. ;;;
  4.   (defun round_point (point val)
  5.     (list
  6.       (* (fix (/ (car point) val)) val)
  7.       (* (fix (/ (cadr point) val)) val)
  8.     )
  9.   )
  10. ;;;
  11. ;;;  groop_list
  12. ;;;
  13.   (defun groop_list (list_ i / first temp_list final_list)
  14.     (setq list_ (mapcar (function (lambda (x)
  15.                                     (list
  16.                                       (round_point (car x) i)
  17.                                       (car x)
  18.                                       (cadr x)
  19.                                     )
  20.                                   )
  21.                         )
  22.                         list_
  23.                 )
  24.     )
  25.     (while list_
  26.       (setq first     (caar list_)
  27.             temp_list (list(cdar list_))
  28.             list_     (cdr list_)
  29.       )
  30.       (while (setq temp (assoc first list_))
  31.         (setq temp_list (cons (cdr temp) temp_list)
  32.               list_     (vl-remove temp list_)
  33.         )
  34.       )
  35.       (setq final_list
  36.              (cons
  37.                (cons first (list temp_list))
  38.                final_list
  39.              )
  40.       )
  41.     )
  42.     final_list
  43.   )
  44. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  45. (if (setq
  46.       nabor
  47.        (ssget
  48.          "_:A"
  49.          (list
  50.            (cons 0 "POINT,TEXT")
  51.          )
  52.        )
  53.     )
  54.   (progn
  55.     (setq nabor (mapcar 'vlax-ename->vla-object
  56.                         (vl-remove-if
  57.                           'listp
  58.                           (mapcar 'cadr
  59.                                   (ssnamex nabor)
  60.                           )
  61.                         )
  62.                 )
  63.     )
  64.     (foreach item nabor
  65.       (if (= (vla-get-objectname item) "AcDbText")
  66.         (setq text_list
  67.                (cons
  68.                  (list
  69.                    (3D->2D
  70.                      (vlax-safearray->list
  71.                        (vlax-variant-value
  72.                          (vla-get-InsertionPoint item)
  73.                        )
  74.                      )
  75.                    )
  76.                    item
  77.                  )
  78.                  text_list
  79.                )
  80.         )
  81.         (setq point_list
  82.                (cons
  83.                  (list
  84.                    (3D->2D
  85.                      (vlax-safearray->list
  86.                        (vlax-variant-value
  87.                          (vla-get-coordinates item)
  88.                        )
  89.                      )
  90.                    )
  91.                    item
  92.                  )
  93.                  point_list
  94.                )
  95.         )
  96.       )
  97.     )
  98. ;Группируем объекты Текст в дерево
  99. (setq i 10)
  100.       (while (> (length (setq text_list (groop_list text_list i))) 2)
  101.         (setq i (* 10 i))
  102.       )
  103. ; Проходимся по списку Точек
  104.       (foreach item point_list
  105.         (setq koord          (car item)
  106.               koord          (list (+ (car koord) d_x) (+ (cadr koord) d_y))
  107. ; Находим 4 угла, в радиусе допуска вокруг искомой точки
  108.               koord_list     (mapcar
  109.                                (function (lambda (x)
  110.                                            (round_point(mapcar '+ koord x)10)
  111.                                          )
  112.                                )
  113.                                '((0.1 -0.1) (0.1 0.1) (-0.1 0.1) (-0.1 -0.1))
  114.                              )
  115. ;Проверяем не попадают ли эти 4 вершины в один "листочик" на дереве (удаляем дубли)
  116.               koord_list     (reverse
  117.                                (cons
  118.                                  (car koord_list)
  119.                                  (vl-remove (car koord_list) (cdr koord_list))
  120.                                )
  121.                              )
  122.               koord_list     (cons (car koord_list)
  123.                                    (vl-remove (car koord_list) (cdr koord_list))
  124.                              )
  125.              
  126.         )
  127. ;Пройдёсь по дереву, из большого списка Текстов выбираем нужные нам листочки
  128.         (setq smol_text_list
  129.                (apply 'append
  130.                       (mapcar (function (lambda (x)
  131.                                           (setq j i
  132.                                                 temp_text_list text_list)
  133.                                           (while (>= j 10)
  134.                                             (setq temp_text_list
  135.                                                    (cadr (assoc
  136.                                                            (round_point
  137.                                                              x
  138.                                                              j
  139.                                                            )
  140.                                                            temp_text_list
  141.                                                          )
  142.                                                    )
  143.                                                   j (/ j 10)
  144.                                             )
  145.                                           )
  146.                                           temp_text_list
  147.                                         )
  148.                               )
  149.                               koord_list
  150.                       )
  151.                )
  152.         )
  153. ; И уже маленький список Текстов проверяем на equal'ом
  154.         (if (setq text
  155.                    (car
  156.                      (vl-remove-if-not
  157.                        (function
  158.                          (lambda (x)
  159.                            (equal (car x) koord 0.1)
  160.                          )
  161.                        )
  162.                        smol_text_list
  163.                      )
  164.                    )
  165.             )
  166.           (progn
  167.             (setq par_list
  168.                    (cons
  169.                      (list
  170.                        koord
  171.                        (cadr item)
  172.                        (cadr text)
  173.                      )
  174.                      par_list
  175.                    )
  176. )

Протестировал, на поиск пар для 20 тысяч точек ушло 8 минут, на слабом ПК, на котором SelSim для тех же точек выполнялся 15 секунд. Поиск пар для тех же 20 тысяч точек первоначальным алгоритмом занял 30 минут.
В общем, думаю стоит добавить прогресс-бар http://autolisp.ru/2013/04/01/progressbars-or-longtime-operations/