### Author Topic: vlax-curve-getfurthestpointfrom  (Read 15131 times)

0 Members and 1 Guest are viewing this topic.

#### ribarm

• Water Moccasin
• Posts: 2334
• Marko Ribar, architect
##### Re: vlax-curve-getfurthestpointfrom
« Reply #60 on: November 04, 2013, 09:04:50 PM »
Little late, but better ever than never... I should have added final touch much much earlier... So here is final (vlax-curve-getfurthestpointfrom)... From my testings, it should return exact point that is furthest from desired point anywhere in 3D...

Code - Auto/Visual Lisp: [Select]
1. (defun vlax-curve-getfurthestpointfrom ( curve pt / _precise sd ed dd p1 p2 d1 d2 d ptt pp p )
2.   (setq p1 T p2 T dd 0.0)
3.   (while (and p1 p2)
4.     (setq p1 (vlax-curve-getpointatdist curve (+ sd dd)))
5.     (setq dd (+ dd (/ ed 100.0)))
6.     (setq d1 (distance pt p1))
7.     (setq p2 (vlax-curve-getpointatdist curve (+ sd dd)))
8.     (if (>= (+ sd dd) ed) (setq p2 (vlax-curve-getendpoint curve)))
9.     (setq d2 (distance pt p2))
10.     (if (null p) (setq p p1))
11.     (if (> d1 (distance pt p)) (setq p p1))
12.     (if (> d2 (distance pt p)) (setq p p2))
13.     (if (> (+ sd dd) ed) (setq p1 nil p2 nil))
14.   )
15.
16.   (defun _precise ( fact / p1 p2 dd d )
17.     (setq p1 T p2 T dd 0.0 d nil)
18.     (while (and p1 p2)
19.       (if (not (equal p (vlax-curve-getstartpoint curve) 1e-8))
20.           (setq p1 (vlax-curve-getpointatdist curve (+ (if (null d) (setq d (- (vlax-curve-getdistatpoint curve p) (/ ed fact))) d) dd)))
21.           (setq dd (+ dd (/ ed fact 100.0)))
22.           (setq d1 (distance pt p1))
23.           (setq p2 (vlax-curve-getpointatdist curve (+ d dd)))
24.           (if (>= (+ d dd) ed) (setq p2 (vlax-curve-getendpoint curve)))
25.           (setq d2 (distance pt p2))
26.           (if (> d2 d1) (setq p p2) (setq p1 nil p2 nil))
27.         )
28.         (setq p1 nil p2 nil)
29.       )
30.     )
31.   )
32.
33.   (_precise (expt 100.0 1.0))
34.   (_precise (expt 100.0 2.0))
35.   (_precise (expt 100.0 3.0))
36.   (_precise (expt 100.0 4.0))
37.   (_precise (expt 100.0 5.0))
38.   (_precise (expt 100.0 6.0))
39.   (_precise (expt 100.0 7.0))
40.   (_precise (expt 100.0 8.0))
41.   (_precise (expt 100.0 9.0))
42.   (_precise (expt 100.0 10.0))
43.
44.   (setq ptt (mapcar '+ pt (mapcar '* '(2.0 2.0 2.0) (mapcar '- p pt))))
45.   (while (not (equal p pp 1e-50))
46.     (setq p pp)
47.     (setq ptt (mapcar '+ pt (mapcar '* '(2.0 2.0 2.0) (mapcar '- p pt))))
48.     (setq pp (vlax-curve-getclosestpointto curve ptt))
49.   )
50.   p
51. )
52.

M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)