[Torino]

Товарищи, программисты!
Напишите, пожалуйста, программу, которая находит самопересечения трехмерной полилинии (с определенным допуском), и помечает их красными точками.
Или подскажите алгоритм программы.

[vk]

Не знаю, как насчет "с допуском", а явные можно попробовать примерно так:
- собрать список координат вершин по порядку следования их в полилинии.
- попробовать найти пересечения отрезков при помощи функции (inters). Порядок проверки такой
-- 1-2 с 3-4,4-5,5-6....
-- 2-3 с 4-5,5-6,6-7...
-- 3-4 с 5-6,6-7,7-8.... и тэдэ

[Олег (jr.)]

;; Как вариант :

;; 12/4/04 0:16 AM
;; Intersection 3dpoly itself

(defun inactx ()
(vl-load-com)
(setq adoc
(vla-get-activedocument
(vlax-get-acad-object))
mdsp (vla-get-modelspace adoc)))

(defun conapp (lst / rlst)
(cond
((null lst) nil)
(T (append rlst (list (list (car lst)(cadr lst)(caddr lst)))
(conapp (cdddr lst))))))

(defun catchlist (pnt)
(vl-load-com)
(if pnt (vl-catch-all-apply
'vlax-safearray->list
(list (vlax-variant-value pnt)))))
;______end of 'helpers_____;

(defun C:ters (/ ob1 ob2 pts rlst
adoc cir en int_lst
mdsp vlst x)
(inactx)
(setq en (car (entsel "\nВыбрать примитив : >>> \n"))
ob1 (vlax-ename->vla-object en)
ob2 (vla-copy ob1)
pts (vl-catch-all-apply 'vla-IntersectWith (list ob1 ob2
acExtendNone))
)
(cond
((vl-catch-all-error-p pts) nil)
((vl-catch-all-error-p
(setq pts (catchlist pts))) nil)
(t pts (while pts
(setq rlst (cons (list (car pts)(cadr pts)(caddr pts))rlst)
pts (cdddr pts))) rlst))
(print rlst)
(setq vlst (conapp (catchlist (vla-get-coordinates ob1))))
(print vlst)
(setq int_lst (vl-remove-if
(function (lambda (X)
(member X vlst))) rlst))
(mapcar '(lambda (x)
(setq cir (vla-addsphere mdsp x 0.2))
(vla-put-color cir acred))
(mapcar 'vlax-3d-point int_lst))
(vla-delete ob2)
(vlax-release-object ob1)
(vla-zoomextents (vla-get-application adoc))
(vla-regen adoc acActiveViewport)
(princ)
)

[Torino]

>>vk
Спасибо за идею.

>>Олег
Спасибо за программу!
Она работает! Особенно понравились красные шары в местах перечечений

[Олег (jr.)]

Боюсь рутина многое не учитывает, например, если пересечение пойдет по вершинам, а насчет красных шаров.. .меня так и подмывало заменить их на медные.