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

0 Members and 1 Guest are viewing this topic.

ribarm

  • Water Moccasin
  • Posts: 1710
  • 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