Author Topic: vlax-curve-getfurthestpointfrom  (Read 13967 times)

0 Members and 1 Guest are viewing this topic.

ribarm

  • Water Moccasin
  • Posts: 2126
  • 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.         (progn
  21.           (setq p1 (vlax-curve-getpointatdist curve (+ (if (null d) (setq d (- (vlax-curve-getdistatpoint curve p) (/ ed fact))) d) dd)))
  22.           (setq dd (+ dd (/ ed fact 100.0)))
  23.           (setq d1 (distance pt p1))
  24.           (setq p2 (vlax-curve-getpointatdist curve (+ d dd)))
  25.           (if (>= (+ d dd) ed) (setq p2 (vlax-curve-getendpoint curve)))
  26.           (setq d2 (distance pt p2))
  27.           (if (> d2 d1) (setq p p2) (setq p1 nil p2 nil))
  28.         )
  29.         (setq p1 nil p2 nil)
  30.       )
  31.     )
  32.   )
  33.  
  34.   (_precise (expt 100.0 1.0))
  35.   (_precise (expt 100.0 2.0))
  36.   (_precise (expt 100.0 3.0))
  37.   (_precise (expt 100.0 4.0))
  38.   (_precise (expt 100.0 5.0))
  39.   (_precise (expt 100.0 6.0))
  40.   (_precise (expt 100.0 7.0))
  41.   (_precise (expt 100.0 8.0))
  42.   (_precise (expt 100.0 9.0))
  43.   (_precise (expt 100.0 10.0))
  44.  
  45.   (setq ptt (mapcar '+ pt (mapcar '* '(2.0 2.0 2.0) (mapcar '- p pt))))
  46.   (while (not (equal p pp 1e-50))
  47.     (setq p pp)
  48.     (setq ptt (mapcar '+ pt (mapcar '* '(2.0 2.0 2.0) (mapcar '- p pt))))
  49.     (setq pp (vlax-curve-getclosestpointto curve ptt))
  50.   )
  51.   p
  52. )
  53.  

M.R.
 8-) 8-) 8-)
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube