[CDR X5-X8] найти ближайшую точку на шейпе к данной точке

  • Автор темы Автор темы Nezar
  • Дата начала Дата начала
Статус
Закрыто для дальнейших ответов.
Ну я ж пример кода в той теме приводил
Код: 
Sub tst()
Set Sel = ActiveSelectionRange
Set peresechenie = Sel(1).Curve.SubPaths(1).GetIntersections(Sel(2).Curve.SubPaths(1))
a = peresechenie.Count
End Sub
Считает множество точек пересечения двух выделенных объектов и его количество
 
  • Спасибо
Реакции: Nezar
спасибо.
я упустил что у шейпа с дырками несколько путей
 
попробовал два метода. свой с дополнительными узлами и новый с окружностями.
вывод - при той же точности, скорость работы окружностей в два и более раз меньше.
конечно можно оптимизировать - но тогда код станет еще больше по размеру, а прирост будет малозаметен.
поэтому пока остановлюсь на узлах.
но спасибо за наводку. буду знать про такой метод!
 
Nezar сказал(а):
конечно можно оптимизировать
Нажмите, чтобы раскрыть...
Возможности для оптимизации просто огромны. Во первых, вовсе необязательно добавлять узлы в кривую - есть замечательный метод GetPointPositionAt, который возвращает координаты точки на сегменте в зависимости от положения
Во вторых, можно комбинировать два метода для более быстрой сходимости - сперва посчитать расстояние до каждого узла, выбрать минимальное, построить окружность с этим радиусом, выбрать точки пересечения с кривой, затем найти координаты середин полученных сегментов, выбрать минимальное расстояние уже среди них, снова построить окружность и.т д, такой итерационнй алгоритм сойдется гораздо быстрее
И, наконец, при здравом рассмотрении, можно и прямое решение запилить. Допустим, у нас есть параметрическое уравнение сегмента:
upload_2017-1-30_11-27-52.png

где B - это выражение для x или y, а P - соответствующие координаты узлов и хинтов
Подставляем это уравнение в формулу для расстояния для целевой точки, получаем функцию расстояния от нее до кривой S(t)
Берем какой-нибудь вольфрам и считаем производную от этой функции S'(t)
Приравниваем эту производную к нулю и тем же вольфрамом получаем формулу корней уравнения S'(t)=0
Бинго! Теперь достаточно перебрать значения расстояния в узлах и корнях этого уравнения для каждого сегмента и найти среди них минимальное - это и будет прямое аналитическое решение данной задачи, самое оптимальное по скорости.
 
Последнее редактирование:
  • Спасибо
Реакции: Nezar
_MBK_ сказал(а):
Во первых, вовсе необязательно добавлять узлы в кривую
Нажмите, чтобы раскрыть...
узлы в кривую я добавляю при простом переборе точек.
понятно что при методе с окружностями это не надо.
про возможности оптимизации я понимаю, но раздувать код из за долей секунды в расчете не хочется. потраченное время на код несоизмеримо с конечным результатом, в данном случае.
но все равно благодарю за формулы и варианты решения вопроса.
 
Nezar сказал(а):
есть некая точка с координатами x y
есть шейп.
нужно найти ближайшую точку к заданной.
Нажмите, чтобы раскрыть...
В данном примере заданная точка имеет координаты (0, 0)
Код: 
Sub ClosestPoint()
    x# = 0
    y# = 0
    Dim po#
    Set a = ActiveShape.DisplayCurve.FindClosestSegment(x, y, po).GetPointAt(po)
    MsgBox "x = " & a.x & vbCr & "y = " & a.y
End Sub
 
  • Спасибо
Реакции: Nezar
Последнее редактирование:
вставил эту функцию в свой код.
выигрыша в скорости нет )) причем иногда на доли секунд медленнее отрабатывает при тех же параметрах и условиях.
но веже плюс есть - одна строчка кода вместо нескольких десятков.
 
Главный плюс все таки в точности. Чтото мне подсказывает, что прямая функция точнее будет считать чем перебор произвольных точек.
 
_MBK_ сказал(а):
Главный плюс все таки в точности. Чтото мне подсказывает, что прямая функция точнее будет считать чем перебор произвольных точек.
Нажмите, чтобы раскрыть...
это безусловно. но мне сверх точность и не нужна была.
хотя думаю при расстоянии между узлами в пол миллиметра, как у меня - думаю точность достаточно высока
в любом случае останусь с этой функцией - она меньше )
 
В заголовке темы указана версия Х8.
FindClosestSegment есть уже в X3, вместо GetPointAt можно использовать GetPointPositionAt. Т.е. код будет примерно такой (проверить не могу, нет Х3 под рукой)
Код: 
Sub ClosestPoint()
    x# = 0
    y# = 0
    Dim po#
    Set a = ActiveShape.DisplayCurve.FindClosestSegment(x, y, po).GetPointPositionAt(po, x, y)
    MsgBox "x = " & x & vbCr & "y = " & y
End Sub
 
lev сказал(а):
FindClosestSegment есть уже в X3
Нажмите, чтобы раскрыть...
Нету, я тебе здесь весь список курвовых методов процитировал
И в X6 нет, специально проверил
А по ссылке из того же сообщения видно, что минимальная версия для данного метода - X7
 
В хелпе нету, в объектной модели есть.
 
Где там про FindClosestSegment ?
 
Статус
Закрыто для дальнейших ответов.
Верх Низ