Topic: vlax-curve-getfurthestpointfrom

[ribarm]

The code was completely updated, it may not work with LWPOLYLINE or POLYLINE VLA-OBJECT with ARC-s... Also XLINE or RAY curve objects may break function, but their furthest point from is in infinity, so never mind; all other cases are computed... Also LWPOLYLINE curve is during execution of function converted to HEAVY POLYLINE, because of bug, but after it's converted back to LWPOLYLINE...

Sincerely, M.R.

[ribarm]

The code was completely updated, it may not work with LWPOLYLINE or POLYLINE VLA-OBJECT with ARC-s... Also XLINE or RAY curve objects may break function, but their furthest point from is in infinity, so never mind; all other cases are computed... Also LWPOLYLINE curve is during execution of function converted to HEAVY POLYLINE, because of bug, but after it's converted back to LWPOLYLINE...

Sincerely, M.R.

All problems removed, you can download *.lsp...

Regards, M.R.

[ribarm]

For those 3 latest downloads, my apology for one last modification... You have to insert line (gc) before end of code to make sure conversion of LWPOLYLINE is correct - in property palette (ctrl+1) you should get data as normal after execution of function...

M.R.
 

[chlh_jd]

Glad you can be in favor of .
However , If distance from point to curve is far enough away, such as must use light-years to desribe , this maximum distance lost meaning . I guess this is why autocad  put the 'getfurthestpointfrom' function  into .

I intended to create this function with some purpose in process of working with AutoCAD. I guess no one will draw entities so far away from checked point... As a matter a fact I already posted one possible usage of this function on www.cadtutor.net (you may google it) and it was with normal demands of CAD (Computer Aided Design)...

Now I didn't know it doing yet , but still in favor of you improving this function .

For Arc perhaps

Code: [Select]

((= "ARC" etype)
  ((lambda (p c r)   
     (vlax-curve-getclosestpointto curve (polar p (angle p c) (+ r r)))     
     )
    (vlax-curve-getclosestpointto curve point)
    (cdr (assoc 10 elst))
    (cdr (assoc 40 elst))   
    )   
  )


[ribarm]

Now I didn't know it doing yet , but still in favor of you improving this function .

For Arc perhaps

Code: [Select]

((= "ARC" etype)
  ((lambda (p c r)   
     (vlax-curve-getclosestpointto curve (polar p (angle p c) (+ r r)))     
     )
    (vlax-curve-getclosestpointto curve point)
    (cdr (assoc 10 elst))
    (cdr (assoc 40 elst))   
    )   
  )


Thanks, chlh_jd for your reply... I thought that function was correct, but thanks to you I've updated it once more... It wasn't working with ARCs, so for those 4 latest downloads I've changed the code and file for download... Once again, my apology - you may test it now, and if you find any mistake, or error, please reply and report me...

M.R.

[chlh_jd]

For Ellipse  (To solve quartic equation , See http://www.theswamp.org/index.php?topic=42656.msg478640#msg478640 )

Code: [Select]


((= "ELLIPSE" etype)
  ((lambda (p1 p2 e / foo ang a b)
     (defun foo (p a b / m n c aa bb cc dd ee xl)
       ;;get furthest point of ellipse which is initialized by Origin and X-axis .
       (setq m (car p)
     n (cadr p)
     c (- (* a a) (* b b))
     aa (* c c)
     bb (* -2 m a a c)
     cc (+ (* n n a a b b) (* m m a a a a) (* -1. a a c c))
     dd (* 2 m a a a a c)
     ee (* -1. m m (expt a 6))
     xl (->eq^4 aa bb cc dd ee)
     xl (mapcar
  (function
    (lambda (x / z)
      (setq z (* b (sqrt (- 1. (expt (/ x a) 2)))))
      (list (list x z) (list x (- z)))))
  xl)
     xl (apply 'append xl))
       (car
(vl-sort xl
  (function (lambda (e1 e2)
      (> (distance p e1) (distance p e2))))))
       )
     (setq ang (angle p2 (list 0 0 0))
   a   (distance p2 (list 0 0 0))
   b   (* a e))
     (vlax-curve-getclosestpointto
       curve
       (gsls-ab->xy (foo (gsls-xy->ab p p1 ang) a b) p1 ang))
     )
    (cdr (assoc 10 elst))
    (cdr (assoc 11 elst))
    (cdr (assoc 40 elst))
    )
  )
;;;将点AB坐标换算为XY坐标，AB坐标的原点为PT0，转角为R0
;;;X=X0+AcosR0-BsinR0
;;;Y=Y0+AsinR0+BcosR0
(defun gsls-AB->XY (pt pt0 ANG / X Y)
  (setq X (+ (car pt0)
     (* (car pt) (cos ANG))
     (* -1 (cadr pt) (sin ANG))
  )
Y (+ (cadr pt0)
     (* (car pt) (sin ANG))
     (* (cadr pt) (cos ANG))
  )
  )
  (list X Y 0.0)
)
;;;将点XY坐标换算为AB坐标，AB坐标的原点为PT0，转角为R0
;;;A=(X-X0)cosR0+(Y-Y0)sinR0
;;;B=(Y-Y0)cosR0-(X-X0)sinR0
(defun gsls-XY->AB (pt pt0 ANG / A B)
  (setq A (+ (* (- (car pt) (car pt0)) (cos ANG))
     (* (- (cadr pt) (cadr pt0)) (sin ANG))
  )
B (- (* (- (cadr pt) (cadr pt0)) (cos ANG))
     (* (- (car pt) (car pt0)) (sin ANG))
  )
  )
  (list A B 0.0)
)
It can be solve by New ELLipse equation which not need trans the point .

Code: [Select]

[(x-x0)cosθ+(y-y0)sinθ]˛/a˛ + [(y-y0)cosθ-(x-x0)sinθ]˛/b˛=1

[DEVITG]

MR, could you please , upload the lisp , or give the link where it is.

[ribarm]

If you can't download it from here :
http://www.theswamp.org/index.php?topic=42246.msg477718#msg477718
(you are not logged)
Then copy+paste the code from here :
http://www.theswamp.org/index.php?topic=42246.msg477835#msg477835
to notepad and save it as vlax-curve-getfurthestpointfrom.lsp

Load *.lsp with appload, and activate vla-functions (vl-load-com)
1. pick point : (setq p (getpoint))
2. pick curve : (setq e (car (entsel))) or if you want you can use VLA-OBJECT also (setq e (vlax-ename->vla-object (car (entsel))))

3. calculate point : (setq pp (vlax-curve-gettfurthestpointfrom e p))

M.R.

[chlh_jd]

Hi ribarm , how about new for Ellipse .

Code: [Select]

((= "ELLIPSE" etype)
  ;;For 3d method
  ((lambda (p1 p2 e norm / foo ang a b p)
     (defun foo (p a b / m n c aa bb cc dd ee xl)
       ;;get furthest point of ellipse which is initialized by Origin and X-axis .
       (setq m (car p)
      n (cadr p)
      c (- (* a a) (* b b))
      aa (* c c)
      bb (* -2 m a a c)
      cc (+ (* n n a a b b) (* m m a a a a) (* -1. a a c c))
      dd (* 2 m a a a a c)
      ee (* -1. m m (expt a 6))
      xl (->eq^4 aa bb cc dd ee)
      xl (mapcar
   (function
     (lambda (x / z)
       (setq z (* b (sqrt (- 1. (expt (/ x a) 2)))))
       (list (list x z) (list x (- z)))))
   xl)
      xl (apply 'append xl))
       (car
(vl-sort xl
   (function (lambda (e1 e2)
       (> (distance p e1) (distance p e2))))))
       )
     (setq  a   (distance p2 (list 0 0 0))
    b   (* a e)
    p (mapcar (function -) (trans point 0 norm) (trans p1 0 norm))    
            p (foo (list (cadr p) (- (car p))) a b)             
    p (trans (mapcar (function +) (list (- (cadr p)) (car p) 0.0) (trans p1 0 norm)) norm 0))
     (vlax-curve-getclosestpointto    curve  p)
     )
    (cdr (assoc 10 elst))
    (cdr (assoc 11 elst))
    (cdr (assoc 40 elst))
    (cdr (assoc 210 elst))
    )
  )
I think you are tired to edit this function 
The vla-intersectwith method  will take so much time in recursion , perhaps this way  : get boundingbox , cal max included circle ,and then cal the point of the circle which closest to the given curve  .

[chlh_jd]

Hi ribarm , how about new for Ellipse .

Code: [Select]

((= "ELLIPSE" etype)
  ;;For 3d method
  ((lambda (p1 p2 e norm / foo ang a b p)
     (defun foo (p a b / m n c aa bb cc dd ee xl)
       ;;get furthest point of ellipse which is initialized by Origin and X-axis .
       ...  )
I think you are tired to edit this function 
The vla-intersectwith method  will take so much time in recursion , perhaps this way  : get boundingbox , cal max included circle ,and then cal the point of the circle which closest to the given curve  .

I found the code I often is not really work for 3D, and it's Accuracy just 1e-3 , perhaps by solve the equation method has much deviation .
Ribarm's thoughts is right .
However , I yet want to post my code for Circle or Arc for 3D  .

Code: [Select]

((= "ARC" etype)
     ((lambda (p c)
(vlax-curve-getclosestpointto
  curve
  (pt+ p (pt* (pt- c p) 2.)))
)
       (vlax-curve-getclosestpointto curve point)
       (cdr (assoc 10 elst))       
       )
     )
    ((= "CIRCLE" etype)
     ((lambda (p c)
(vlax-curve-getclosestpointto curve (pt+ p (pt* (pt- c p) 2.)))
)
       (vlax-curve-getclosestpointto curve point)
       (cdr (Assoc 10 elst))       
       )
     )
;;;Vector +
(defun pt+ (pt1 pt2)
  (mapcar (function +)
  pt1
  pt2
  )
)
;;;Vector -
(defun pt- (pt2 pt1)
  (mapcar (function -)
  pt2
  pt1
  )
)
;;;Vector *
(defun pt* (v sc)
  (mapcar (function (lambda (x)
      (* x sc)
    )
  )
  v
  )
)


[chlh_jd]

This flower LwPolyLine has 8 furthest points if the given point is center .
Routine loop not end .

[ribarm]

For this case, you had not to relay on computations, but you'll have to input different point than center (any other point that lies on axises I drawn from center - see my jpg)...

[chlh_jd]

My version , Use the method on the reply #53

Code: [Select]

(defun c:test  (/ en pt p2)
  (setq en (car (entsel)))
  (setq pt (trans (getpoint) 1 0)) 
  (if (setq p2 (getfurthestpointfrom en pt))
    (progn
      (entmake (list (cons 0 "LINE")
     (cons 10 pt)
     (cons 11 p2)
     (cons 62 1)))
      (princ (strcat "\n Maxdistance = " (rtos (distance pt p2) 2 8)))
      ))
  (princ)
  )
(defun getfurthestpointfrom  (en pt / en ent etype pt p1 p R p2 d d1 d2 p3 p4 p5 p6)
  ;;; GetFurthestpointfrom for 3D curve .
  ;;; For Periodic Curve ( not for LINE , Xline ...)
  ;;; GSLS(SS) 2012-9-13
  (if (and en
   pt
   (setq ent (entget en))
   (not (member (setq etype (strcase (dxf 0 ent))) (list "LINE" "XLINE" "RAY"))))      
    (progn
      ((lambda (obj / minpt maxpt box)
(vla-GetBoundingBox
   obj
   (quote minpt)
   (quote maxpt))
(setq minPt (vlax-safearray->list minPt)
       maxPt (vlax-safearray->list maxPt))
(setq box (vlex-ex2con (list minpt maxpt)))
(setq
   p (car
       (vl-sort
box
(function
   (lambda (p1 p2)
     (> (distance pt p1) (distance pt p2)))))))
(vlax-release-object obj))
(vlax-ename->vla-object en))
      (setq R  (distance pt p)
    p2 (vlax-curve-getclosestpointto en p))
      (setq d (distance pt p2))
      (while (< d
(setq
  d1 (distance pt
       (setq p3
      (vlax-curve-getclosestpointto
en
(pt+
  pt
  (pt* (v2u (mapcar (function -) p2 pt))
       r)))))))
(setq d d1
      p2 p3))
      (while
(< d
   (setq
     d1 (distance
  pt
  (setq
    p4 (vlax-curve-getclosestpointto
en
(midpt p2 p3))))))
(setq d  d1
       p3 p2
       p2 p4))
      (while (or (< d
    (setq d1
   (distance
     pt
     (setq p5 (vlax-curve-getclosestpointto
en
(midpt p2 p4))))))
(< d
    (setq d2
   (distance
     pt
     (setq p6 (vlax-curve-getclosestpointto
en
(midpt p3 p4)))))))
(if p6
  (setq d  d2
p2 p4)
  (setq d  d1
p3 p4))
(setq p4 (vlax-curve-getclosestpointto en (midpt p2 p3))
      p5 nil
      p6 nil)))
      (if (= etype "LINE")
(if (> (distance pt (setq p1 (dxf 10 ent))) (distance pt (setq p2 (dxf 11 ent))))
    (setq p2 p1)))
    )
   p2
  )
;;;-----------------------------
;;; Use functions
(defun dxf (n l)
  (cdr (assoc n l)))
 
(defun midpt (pta ptb)
  (mapcar (function (lambda (x y)
      (/ (+ x y) 2.0)
    )
  )
  pta
  ptb
  )
)
;;;Vector +
(defun pt+ (pt1 pt2)
  (mapcar (function +)
  pt1
  pt2
  )
)
;;;Vector -
(defun pt- (pt2 pt1)
  (mapcar (function -)
  pt2
  pt1
  )
)
;;;Vector *
(defun pt* (v sc)
  (mapcar (function (lambda (x)
      (* x sc)
    )
  )
  v
  )
)
;;; Vector Unit
(defun v2u (v / d)
 (setq d (sqrt (apply (function +) (mapcar (function *) v v))))
 (if (/= d 0)   
   (mapcar (function (lambda (x) (/ x d))) v)   
   )
)
(defun vlex-ex2con  (pts / 2dbox)
  (defun 2dbox (p1 p2)
    (list p1
  (cons (car p2) (cdr p1))
  p2
  (cons (car p1) (cdr p2))))
  (setq pts (mapcar (function (lambda (x) (trans x 0 0))) pts))
  (if (= (caddar pts) (caddr (cadr pts)))
    (2dbox (car pts) (cadr pts))
    (append
      (2dbox
(car pts)
(list (caadr pts) (cadadr pts) (caddar pts)))
      (2dbox
(list (caar pts) (cadar pts) (caddr (cadr pts)))
(cadr pts)))
    ))


[chlh_jd]

No closed spline is not Periodic , I update codes on up post.

[ribarm]

I've rewritten this function to be more concise and better for usage...

This version is little larger, and may fail in some cases like the one posted above.
So I don't guarantee for this one, but if works on 2d curves, result is the most precise :

Code: [Select]

(defun vlax-curve-getfurthestpointfrom ( curve pt / _precise LM:ProjectPointToPlane
                                                     sd ed dd p1 p2 d1 d2 d p pc rad ci k r rr )

  (setq sd (vlax-curve-getdistatparam curve (vlax-curve-getstartparam curve)))
  (setq ed (vlax-curve-getdistatparam curve (vlax-curve-getendparam curve)))
  (setq p1 T p2 T dd 0.0)
  (while (and p1 p2)
    (setq p1 (vlax-curve-getpointatdist curve (+ sd dd)))
    (setq dd (+ dd (/ ed 100.0)))
    (setq d1 (distance pt p1))
    (setq p2 (vlax-curve-getpointatdist curve (+ sd dd)))
    (if (>= (+ sd dd) ed) (setq p2 (vlax-curve-getendpoint curve)))
    (setq d2 (distance pt p2))
    (if (null p) (setq p p1))
    (if (> d1 (distance pt p)) (setq p p1))
    (if (> d2 (distance pt p)) (setq p p2))
    (if (> (+ sd dd) ed) (setq p1 nil p2 nil))
  )

  (defun _precise ( fact / p1 p2 dd d )
    (setq p1 T p2 T dd 0.0 d nil)
    (while (and p1 p2)
      (if (not (equal p (vlax-curve-getstartpoint curve) 1e-8))
        (progn
          (setq p1 (vlax-curve-getpointatdist curve (+ (if (null d) (setq d (- (vlax-curve-getdistatpoint curve p) (/ ed fact))) d) dd)))
          (setq dd (+ dd (/ ed fact 100.0)))
          (setq d1 (distance pt p1))
          (setq p2 (vlax-curve-getpointatdist curve (+ d dd)))
          (if (>= (+ d dd) ed) (setq p2 (vlax-curve-getendpoint curve)))
          (setq d2 (distance pt p2))
          (if (> d2 d1) (setq p p2) (setq p1 nil p2 nil))
        )
        (setq p1 nil p2 nil)
      )
    )
  )

  (_precise (expt 100.0 1.0))
  (_precise (expt 100.0 2.0))
  (_precise (expt 100.0 3.0))
  (_precise (expt 100.0 4.0))
  (_precise (expt 100.0 5.0))
  (_precise (expt 100.0 6.0))
  (_precise (expt 100.0 7.0))
  (_precise (expt 100.0 8.0))
  (_precise (expt 100.0 9.0))
  (_precise (expt 100.0 10.0))

  (defun LM:ProjectPointToPlane ( pt org nm )
    (setq pt  (trans pt  0 nm)
          org (trans org 0 nm)
    )
    (trans (list (car pt) (cadr pt) (caddr org)) nm 0)
  )

  (if (eq (vlax-curve-isplanar curve) T)
    (progn
      (setq pc (LM:ProjectPointToPlane pt (vlax-curve-getstartpoint curve) (cdr (assoc 210 (entget curve)))))
      (setq rad (distance pc p))
      (setq pc (trans pc 0 (cdr (assoc 210 (entget curve)))))
      (setq ci (entmakex (list (cons 0 "CIRCLE") (cons 10 pc) (cons 40 rad) (assoc 210 (entget curve)))))
      (setq cid (entget ci))
      (while (not (setq p (vlax-invoke (vlax-ename->vla-object curve) 'IntersectWith (vlax-ename->vla-object ci) acExtendNone)))
        (entmod (subst (list 10 (if (equal (cadr (assoc 10 cid)) 0.0 1e-8) 0.0 (cadr (assoc 10 cid))) (if (equal (caddr (assoc 10 cid)) 0.0 1e-8) 0.0 (caddr (assoc 10 cid))) (if (equal (cadddr (assoc 10 cid)) 0.0 1e-8) 0.0 (cadddr (assoc 10 cid)))) (assoc 10 cid) cid))
        (entupd ci)
      )
      (setq k 0.0)
      (while (> (length p) 3)
        (setq r (+ rad (* 5e-8 (setq k (1+ k)))))
        (entmod (subst (cons 40 r) (assoc 40 cid) cid))
        (entupd ci)
        (setq p (vlax-invoke (vlax-ename->vla-object curve) 'IntersectWith (vlax-ename->vla-object ci) acExtendNone))
      )
      (setq k 0.0)
      (setq r (cdr (assoc 40 (entget ci))))
      (while (/= (length p) 3)
        (setq rr (- r (* 5e-11 (setq k (1+ k)))))
        (entmod (subst (cons 40 rr) (assoc 40 cid) cid))
        (entupd ci)
        (setq p (vlax-invoke (vlax-ename->vla-object curve) 'IntersectWith (vlax-ename->vla-object ci) acExtendNone))
      )
      (entdel ci)
      p
    )
    p
  )
)

So instead of this one, I strongly suggest that you use this one even shorter, but applicable in all cases,
although not so precise, but until Autodesk launch real version, this one is the most advanced until now :

Code - Auto/Visual Lisp: [Select]

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

Regards, all the best in using (vlax-curve-getfurthestpointfrom)
M.R.