(defun c:cont2pts
( / unit unique plremnonunique collinear
-p ss i lw ellw lwpts lworts lwptsorts orts lwsptsorts ptortptl p1s p1 p2 p3 pl pll d pxx pxx1 pxx2 pyy pyy1 pyy2
)
)
)
(defun plremnonunique
( l
) )
)
l
)
(defun collinear
-p
( p1 p p2
) )
)
)
)
)
(setq orts
(unique orts
)) )
)
)
;(setq pl (plremnonunique pl))
;|
(foreach px pl
(setq pll (cons (car px) pll))
(setq pxx1 (cadr (vl-sort pl '(lambda ( a b ) (< (distance (caadr a) (caadr px)) (distance (caadr b) (caadr px)))))))
(setq pxx2 (if (equal (car (setq pxx (vl-sort pl '(lambda ( a b ) (< (distance (cadadr a) (caadr px)) (distance (cadadr b) (caadr px))))))) px 1e-6) (cadr pxx) (car pxx)))
(if (caadr px)
(setq p2 (if (and (inters (car px) (caadr px) (car pxx1) (caadr pxx1) nil) (inters (car px) (caadr px) (car pxx2) (cadadr pxx2) nil))
(if (< (distance (inters (car px) (caadr px) (car pxx1) (caadr pxx1) nil) (caadr px)) (distance (inters (car px) (caadr px) (car pxx2) (cadadr pxx2) nil) (caadr px)))
(inters (car px) (caadr px) (car pxx1) (caadr pxx1) nil)
(inters (car px) (caadr px) (car pxx2) (cadadr pxx2) nil)
)
(cond
( (and (inters (car px) (caadr px) (car pxx1) (caadr pxx1) nil) (not (inters (car px) (caadr px) (car pxx2) (cadadr pxx2) nil)))
(inters (car px) (caadr px) (car pxx1) (caadr pxx1) nil)
)
( (and (inters (car px) (caadr px) (car pxx2) (cadadr pxx2) nil) (not (inters (car px) (caadr px) (car pxx1) (caadr pxx1) nil)))
(inters (car px) (caadr px) (car pxx2) (cadadr pxx2) nil)
)
( t nil )
)
)
)
(setq p2 nil)
)
(setq pyy1 (cadr (vl-sort pl '(lambda ( a b ) (< (distance (cadadr a) (cadadr px)) (distance (cadadr b) (cadadr px)))))))
(setq pyy2 (if (equal (car (setq pyy (vl-sort pl '(lambda ( a b ) (< (distance (caadr a) (cadadr px)) (distance (caadr b) (cadadr px))))))) px 1e-6) (cadr pyy) (car pyy)))
(if (cadadr px)
(setq p3 (if (and (inters (car px) (cadadr px) (car pyy1) (cadadr pyy1) nil) (inters (car px) (cadadr px) (car pyy2) (caadr pyy2) nil))
(if (< (distance (inters (car px) (cadadr px) (car pyy1) (cadadr pyy1) nil) (cadadr px)) (distance (inters (car px) (cadadr px) (car pyy2) (caadr pyy2) nil) (cadadr px)))
(inters (car px) (cadadr px) (car pyy1) (cadadr pyy1) nil)
(inters (car px) (cadadr px) (car pyy2) (caadr pyy2) nil)
)
(cond
( (and (inters (car px) (cadadr px) (car pyy1) (cadadr pyy1) nil) (not (inters (car px) (cadadr px) (car pyy2) (caadr pyy2) nil)))
(inters (car px) (cadadr px) (car pyy1) (cadadr pyy1) nil)
)
( (and (inters (car px) (cadadr px) (car pyy2) (caadr pyy2) nil) (not (inters (car px) (cadadr px) (car pyy1) (cadadr pyy1) nil)))
(inters (car px) (cadadr px) (car pyy2) (caadr pyy2) nil)
)
( t nil )
)
)
)
(setq p3 nil)
)
(if p2 (setq pll (cons p2 pll)))
(if p3 (setq pll (cons p3 pll)))
)
|;
)
)
)
;|
(foreach p1 p1s
(setq d 0.0)
(foreach px (vl-remove-if-not '(lambda ( x ) (equal (car x) p1 1e-6)) pl)
(if (> (distance (caadr px) (car px)) d) (setq p (caadr px) d (distance (caadr px) (car px))))
)
(if (not (vl-member-if '(lambda ( x ) (equal p x 1e-6)) pll))
(setq pll (cons p pll))
)
(setq d 0.0)
(foreach px (vl-remove-if-not '(lambda ( x ) (equal (car x) p1 1e-6)) pl)
(if (> (distance (cadadr px) (car px)) d) (setq p (cadadr px) d (distance (cadadr px) (car px))))
)
(if (not (vl-member-if '(lambda ( x ) (equal p x 1e-6)) pll))
(setq pll (cons p pll))
)
)
|;
)
)