Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → LISP → вычисление списка точек на объекте расстояния между которыми равны
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Похоже нет штатного средства для решения проблемы -
как разметить объект через равные интервалы
https://www.caduser.ru/forum/topic44357.html
Помогите пожалуйста написать функцию, возвращающую список точек указанного пользователем объекта типа 2-3Д-полилиния, spline расстояние между которыми равны и определяется аргументом.
vlax-curve-getpointatdist тебе поможет.
> Кулик Алексей aka kpblc
Это не совсем то, что ему нужно. Она вычисляет расстояние вдоль кривой.
> Александр Ривилис
я полагал, что spline - это еще один тип объектов, которые надо обрабатывать. А если измерять "spline-расстояние", то тогда даже не представляю, как это реализовывать...
> Кулик Алексей aka kpblc
то тогда даже не представляю, как это реализовывать.
Я не очень хорошо ориентируюсь в лиспе(((
Возможно ли реализовать сл. алгоритм -
1. выбор объекта напр. spline
2. создание объекта circle заданного радиуса в начальной точке spline
3. определение точки пересечения spline c circle
координаты которой поместить в список
4. стереть circle
5. создание объекта circle заданного радиуса в предыдущей точке пересечения со spline
6. определить точки пересечения spline c новой circle
7.
координату точки которая отсутствует в списке сохраненных точек поместить в список
пункты 5-7 повторить пока не кончится сплайн
> Кулик Алексей aka kpblc
Фактически ему нужно строить окружности заданного радиуса (половина расстояния между точками) и находить точки пересечения окружностей с кривыми.
> Александр Ривилис
Не-а, не надо. Как описано в > Student (2008-10-02 12:13:19), не надо ничего строить.
(defun test (step / obj len cur_len res dist tmp)
; step - Шаг. Число, больше 0 и меньше длины объекта
(vl-load-com)
(if
(and (= (type (setq obj (vl-catch-all-apply
(function
(lambda ()
(ssname (ssget "_:S:E" '((0 . "*LINE"))) 0)
) ;_ end of LAMBDA
) ;_ end of function
) ;_ end of VL-CATCH-ALL-APPLY
) ;_ end of setq
) ;_ end of type
'ename
) ;_ end of =
(member (type step) (list 'int 'real))
(setq obj (vlax-ename->vla-object obj))
(setq len (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj)))
(<= 0 step len)
(setq cur_len 0)
(setq res (list (vlax-curve-getstartpoint obj)))
) ;_ end of and
(while
(and (< (setq
dist
(vlax-curve-getdistatpoint
obj
(setq tmp (vlax-curve-getpointatdist
obj
(* (setq cur_len (1+ cur_len)) step)
) ;_ end of vlax-curve-getpointatdist
) ;_ end of setq
) ;_ end of vlax-curve-getdistatpoint
) ;_ end of setq
len
) ;_ end of <=
(/= dist 0.)
) ;_ end of and
(setq res (cons tmp res))
) ;_ end of while
) ;_ end of if
(reverse res)
) ;_ end of defun> Кулик Алексей aka kpblc
IMHO ты не прав. Построй по полученным точкам полилинию и убедись, что длины сегментов разные (если у исходной кривой есть дуги или это сплайн).
У меня тоже не получилось (((
(defun c:ttt () (setq _sp (test 1000)) (command "_pline") (foreach XXX _sp (command XXX)) (command "") )
Каюсь, каюсь... Был сильно неправ.
> Student
Ну ты же сам описал алгоритм. Дело за малым - самому его и воплотить. 
> Александр Ривилис
"Дело за малым"
Ох если бы за малым, давно бы уж воплотил )
Если уж у асов сразу не получается то у меня то ... (
Ну а если подскажете функцию возвращающую точки пересечения двух объектов, то может и получится самому воплотить.
Ну а если подскажете функцию возвращающую точки пересечения двух объектов, то может и получится самому воплотить.
(vla->IntersectWith ...)
Если придираться, то
vla-intersectwith vla-object1 vla-object2 ExtensionMode
Стрелки нет.
> Александр Ривилис
> Кулик Алексей aka kpblc
Спасибо!
Приступлю вечером к воплощению ...
> Student
Для ускорения воплощения
VxGetInters - Returns all intersection points between two objects
типа того
(vl-load-com)
(defun test (EntName
Step
/
Dist
EndPoint
Fuzz
OutList
StartPoint
EndDist
)
(setq Fuzz 0.01
Dist Step
EndDist (vlax-curve-getDistAtParam
EntName
(vlax-curve-getEndParam EntName)
)
StartPoint (vlax-curve-getPointAtDist EntName 0.0)
OutList (list StartPoint)
)
(while (< Dist EndDist)
(while (and (< Dist EndDist)
(setq EndPoint (vlax-curve-getPointAtDist
EntName
(setq Dist (+ Dist Fuzz))
)
)
(< (distance StartPoint EndPoint) Step)
)
)
(if (< Dist EndDist)
(setq OutList (cons EndPoint OutList)
StartPoint EndPoint
Dist (+ Dist Step)
)
)
)
OutList
)
;;;(test (car (entsel "\nPath: ")) (getdist "\nStep: "))> VVA
Спасибо за ссылочку, много чего полезного там увидал ...
К воплощению пока не приступал -
увидел код от
> Vovka
проверил на разносегментных полилиниях, эллипсах математических и полилинейных
все работает.
на 3D полилиниях подтормаживает
на сплайнах думал зависает, но после некоторого ожидания всетаки отработала.
здорово!!!
О чудо - она даже на неплоских 3D полилиниях и сплайнах отработала
Огромное спасибо!!!
> Vovka
хороший пример, но было бы лучше не делать полный перебор всех вариантов с маленьким шагом.
Лучше брать диапазон и дальше его уточнять деля пополам... Подзабыл, как правильно называется этот алгоритм. :(
> Евгений Елпанов
По моему так и называется: Метод половинчатого деления
> VVA
Ага, что то типа.
А еще проще, решить эту задачу будет вычислением разницы между дистанцией до текущей предполагаемой точки и шагом.
т.е. пример, шаг выбран в 100, отмеренная вдоль контура точка на расстоянии 100, будет находиться на расстоянии 90 по прямой и значит, мы можем сразу добавить разницу, т.е. 100-90=10 и проверить точку на расстоянии 110 от начала. Это займет гораздо меньше проверок, чем при проверках всех вариантов с единым шагом, равным необходимой точности...
вот пример по моему последнему сообщению:
(defun test (e b f / D D1 ED L)
;;(setq e(car(entsel))s 100. f 1e-6)
;;(test e 100. 1e-6)
(setq d1 b
l (cons (vlax-curve-getStartPoint e) l)
ed (vlax-curve-getDistAtParam
e
(vlax-curve-getEndParam e)
) ;_ vlax-curve-getDistAtParam
) ;_ setq
(while (< d1 ed)
(while
(and (< d1 ed)
(> (setq d
(-
b
(distance (car l) (vlax-curve-getPointAtDist e d1))
) ;_ -
) ;_ setq
f
) ;_ >
) ;_ and
(setq d1 (+ d d1))
) ;_ while
(setq l (cons (vlax-curve-getPointAtDist e (+ d d1)) l)
d1 (+ d1 b)
) ;_ setq
) ;_ while
l
)
Можно и так:
(defun test (/ test test1 pl step)
;;;https://www.caduser.ru/forum/topic39475.html
(defun test (a b f d x)
(if (= a b)
nil
((lambda (r)
(if (equal (f r x) 0. d)
r
(if (minusp (* (f a x) (f r x)))
(test a r f d x)
(test r b f d x)
) ;_ if
) ;_ if
) ;_ lambda
(/ (+ a b) 2.)
)
) ;_ if
) ;_ defun
(defun test1 (par dist)
(if par
(cons (vlax-curve-getPointAtParam pl par)
(test1 (test
par
(vlax-curve-getEndParam pl)
(lambda (x y)
(- step
(distance (vlax-curve-getPointAtParam pl y)
(vlax-curve-getPointAtParam pl x)
) ;_ end of distance
) ;_ end of -
) ;_ end of lambda
1e-6
par
) ;_ end of test
step
) ;_ end of test1
) ;_ end of cons
) ;_ end of if
) ;_ end of defun
(if (and
(setq pl (vlax-ename->vla-object
(car (entsel "\nВыберите pline: "))
) ;_ end of vlax-ename->vla-object
) ;_ end of setq
(setq step (getreal "\nВедите шаг: "))
) ;_ end of and
(test1 (vlax-curve-getStartParam pl) step)
) ;_ end of if
) ;_ end of defun> Евгений Елпанов
согласен :)
> CB
Точно!
Этот метод называется методом бисекции :)
Никак не мог вспомнить название, а алгоритмы я не забываю...
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → LISP → вычисление списка точек на объекте расстояния между которыми равны
Форум работает на PunBB, при поддержке Informer Technologies, Inc
