TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: ribarm on July 12, 2012, 12:58:59 PM

Title: vlax-curve-getfurthestpointfrom
Post by: ribarm on July 12, 2012, 12:58:59 PM

Hi all, I am pretty stucked here... I've tried to write missing vlax-curve-function, but keep getting error :

Code: [Select]

(setq e (car (entsel))) => picked curve - spline
(setq p (getpoint)) => picked point

Command: (vlax-curve-getfurthestpointto e p)
Hard error occurred ***
internal stack limit reached (simulated)

Here is my function :

Code - Auto/Visual Lisp: [Select]

1. (vl-load-com)
2. (defun vlax-curve-getfurthestpointto ( ent pt / f )
3.   (defun f ( ps pe e p / stpar enpar par1 par2 p1 p2 p3 p4 ptlst ptlstsort )
4.   (if (null stpar) (setq stpar (vlax-curve-getstartparam e)) (setq stpar (vlax-curve-getparamatpoint e ps)))
5.   (if (null enpar) (setq enpar (vlax-curve-getendparam e)) (setq enpar (vlax-curve-getparamatpoint e pe)))
6.   (setq par1 (+ stpar (* (- enpar stpar) (/ 1.0 3.0))))
7.   (setq par2 (+ stpar (* (- enpar stpar) (/ 2.0 3.0))))
8.   (setq p1 (vlax-curve-getpointatparam e stpar))
9.   (setq p2 (vlax-curve-getpointatparam e par1))
10.   (setq p3 (vlax-curve-getpointatparam e par2))
11.   (setq p4 (vlax-curve-getpointatparam e enpar))
12.   (setq ptlst (list p1 p2 p3 p4))
13.   (setq ptlstsort (vl-sort ptlst '(lambda ( a b ) (> (distance p a) (distance p b)))))
14.   (if (= (length ptlstsort) 4)
15.     (if (< (vlax-curve-getparamatpoint e (car ptlstsort)) (vlax-curve-getparamatpoint e (cadr ptlstsort)))
16.       (f (car ptlstsort) (cadr ptlstsort) e p)
17.       (f (cadr ptlstsort) (car ptlstsort) e p)
18.     )
19.     (car ptlstsort)
20.   )
21.   )
22.   (f nil nil ent pt)
23. )
24.  

Can someone help?

M.R.

Title: Re: vlax-curve-getfurthestpointto
Post by: BlackBox on July 12, 2012, 02:01:51 PM

Marco,

Perhaps I am not understanding what you are trying to do, but wouldn't the 'furthest point from' be either the start or end point (or both if selecting the midpoint)?  :?

Title: Re: vlax-curve-getfurthestpointto
Post by: ronjonp on July 12, 2012, 02:29:50 PM

Not necessarily...

Title: Re: vlax-curve-getfurthestpointto
Post by: ribarm on July 12, 2012, 02:36:52 PM

I want that algorithm search for the point it's easiest to find...

@Render - I suppose you thought on line as curve or circle and mid or center for point...
Then, like (vlax-curve-getclosestpointto) function retrieves point on circle when picked center as reference point, I want to make (vlax-curve-getfurthestpointto) function...

@Ron - I agree, you can get one solution witch I am searching for...

M.R.

Title: Re: vlax-curve-getfurthestpointto
Post by: BlackBox on July 12, 2012, 02:40:21 PM

I'm still not understanding, so I'll just step back and observe for a bit. All of the smart talk is not computing for me today... Good luck, Marco.

Title: Re: vlax-curve-getfurthestpointto
Post by: zoltan on July 12, 2012, 02:44:32 PM

Shouldn't it be furthest point FROM?  :-D

I think this is going to recurse forever because (length ptlstsort) is always going to be 4.

Title: Re: vlax-curve-getfurthestpointto
Post by: ribarm on July 12, 2012, 02:54:50 PM

Function name isn't so important I thought TO - like closest point to...

My function uses vl-sort function witch should remove duplicates when reaching solution point, so (length ptlstsort) shouldn't be always 4 - that was the main point of my code... But now I see that recursion isn't so good approach as there are cases when length should be 4 and already met opportunities for solution : line with mid or circle, ellipse with center...

Title: Re: vlax-curve-getfurthestpointto
Post by: BlackBox on July 12, 2012, 02:55:14 PM

Quote from: ronjonp on July 12, 2012, 02:29:50 PM

Not necessarily...

Just saw this, thanks ronjon.  :wink:

Title: Re: vlax-curve-getfurthestpointto
Post by: zoltan on July 12, 2012, 03:14:43 PM

Quote from: ribarm on July 12, 2012, 02:54:50 PM

Function name isn't so important I thought TO - like closest point to...

My function uses vl-sort function witch should remove duplicates when reaching solution point, so (length ptlstsort) shouldn't be always 4 - that was the main point of my code... But now I see that recursion isn't so good approach as there are cases when length should be 4 and already met opportunities for solution : line with mid or circle, ellipse with center...

Oh yea.. for some reason I thought VL-Sort would always return a list of the same length.

If I am understanding this correctly, you are dividing the curve into 4 points, the start point, 1/3, 2/3 and the end point.  Then sorting this list by the descending distance from the test point and recursing the function between the furthest point and the second furthest point in a divide-and-concur type approach.

It might take a very long time before the function reaches a local minimum and two distances in the list will be the same because the real number that represents the parameter at the point can be very accurate.  You may need to see if the two distances parameters differ by some tolerance.

The other problem is when the actual furthest point is not between the first and second test points. See attached case:

Title: Re: vlax-curve-getfurthestpointto
Post by: zoltan on July 12, 2012, 05:00:13 PM

Code - Auto/Visual Lisp: [Select]

1. (Defun ZF-GetFurthestPointFrom (CURVE POINT / FurthestParameter )
2.  (Defun FurthestParameter (SP EP TOL / params dist )
3.   (SetQ params (List SP
4.                      (+ SP (* (- EP SP) (/ 1.0 3.0)) )
5.                      (+ SP (* (- EP SP) (/ 2.0 3.0)) )
6.                      EP
7.                )
8.   )
9.  
10.   (SetQ dist (Vl-Sort-I params
11.                         (Function
12.                          (Lambda (a b)
13.                           (> (Distance POINT (VLAX-Curve-GetPointAtParam CURVE a))
14.                              (Distance POINT (VLAX-Curve-GetPointAtParam CURVE b))
15.                           )
16.                          )
17.                         )
18.              )
19.   )
20.  
21.   (If (> (- EP SP) TOL)
22.    (FurthestParameter
23.     (If (= (Car dist) 0)
24.      (Nth (Car dist) params )
25.      (Nth (1- (Car dist)) params )
26.     )
27.     (If (= (Car dist) (1- (Length params)))
28.      (Nth (Car dist) params )
29.      (Nth (1+ (Car dist)) params )
30.     )
31.     TOL
32.    )
33.    (Nth (Car dist) params)
34.   )
35.  )
36.  
37.  (VLAX-Curve-GetPointAtParam CURVE (FurthestParameter (VLAX-Curve-GetStartParam CURVE) (VLAX-Curve-GetEndParam CURVE) 0.0001) )
38. )
39.  

Title: Re: vlax-curve-getfurthestpointto
Post by: ribarm on July 12, 2012, 05:11:39 PM

Thanks, Zoltan... It works very well...

I thought ab tolerance and you were faster and I failed to complete my code... Yours is fine...

M.R. :wink:

Title: Re: vlax-curve-getfurthestpointto
Post by: zoltan on July 12, 2012, 05:30:08 PM

I'm just happy I still remember how to write Lisp!  :lmao:

Minor (anal) revision:

Code - Auto/Visual Lisp: [Select]

1. (Defun ZF-GetFurthestPointFrom (CURVE POINT / FurthestParameter epsilon )
2.  (SetQ epsilon 0.0001 )
3.  (Defun FurthestParameter (SP EP / params furthest )
4.   (SetQ params (List SP
5.                      (+ SP (* (- EP SP) (/ 1.0 3.0)) )
6.                      (+ SP (* (- EP SP) (/ 2.0 3.0)) )
7.                      EP
8.                )
9.   )
10.  
11.   (SetQ furthest (Car (Vl-Sort-I params
12.                                  (Function
13.                                   (Lambda (a b)
14.                                    (> (Distance POINT (VLAX-Curve-GetPointAtParam CURVE a))
15.                                       (Distance POINT (VLAX-Curve-GetPointAtParam CURVE b))
16.                                    )
17.                                   )
18.                                  )
19.                       )
20.                  )
21.   )
22.  
23.   (If (> (- EP SP) epsilon)
24.    (FurthestParameter
25.     (If (= furthest 0)
26.      (Nth furthest params )
27.      (Nth (1- furthest) params )
28.     )
29.     (If (= furthest (1- (Length params)))
30.      (Nth furthest params )
31.      (Nth (1+ furthest) params )
32.     )
33.    )
34.    (Nth furthest params)
35.   )
36.  )
37.  
38.  (VLAX-Curve-GetPointAtParam CURVE (FurthestParameter (VLAX-Curve-GetStartParam CURVE) (VLAX-Curve-GetEndParam CURVE)) )
39. )
40.  

Title: Re: vlax-curve-getfurthestpointto
Post by: Lee Mac on July 12, 2012, 05:43:06 PM

The process could be more efficient for some entities for which the extrema must lie on the vertices:

Code - Auto/Visual Lisp: [Select]

1. (defun vlax-curve-getfurthestpointfrom ( ent pt / elst etype )
2.     (setq elst (entget ent))
3.     (cond
4.         (   (= "XLINE" (setq etype (cdr (assoc 0 elst))))
5.             nil
6.         )
7.         (   (= "LINE" etype)
8.             (if (< (distance pt (cdr (assoc 10 elst)))
9.                    (distance pt (cdr (assoc 11 elst)))
10.                 )
11.                 (cdr (assoc 11 elst))
12.                 (cdr (assoc 10 elst))
13.             )
14.         )
15.         (   (and
16.                 (= "LWPOLYLINE" etype)
17.                 (vl-every '(lambda ( x ) (or (/= 42 (car x)) (zerop (cdr x)))) elst)
18.             )
19.             (car
20.                 (vl-sort (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) elst))
21.                     (function
22.                         (lambda ( a b ) (> (distance pt a) (distance pt b)))
23.                     )
24.                 )
25.             )
26.         )
27.         (   t
28.             <other entities>
29.         )
30.     )
31. )

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on July 13, 2012, 01:15:52 AM

Thank you Lee very much... Only skipped "RAY", so my final function with acceptable tolerance for almost if not exact result is 1e-8...

Code - Auto/Visual Lisp: [Select]

1. (Defun ZF-GetFurthestPointFrom (CURVE POINT TOL / FurthestParameter )
2. (Defun FurthestParameter (SP EP TOL / params dist )
3.  (SetQ params (List SP
4.                     (+ SP (* (- EP SP) (/ 1.0 3.0)) )
5.                     (+ SP (* (- EP SP) (/ 2.0 3.0)) )
6.                     EP
7.               )
8.  )
9.  
10.  (SetQ dist (Vl-Sort-I params
11.                        (Function
12.                         (Lambda (a b)
13.                          (>= (Distance POINT (VLAX-Curve-GetPointAtParam CURVE a))
14.                              (Distance POINT (VLAX-Curve-GetPointAtParam CURVE b))
15.                          )
16.                         )
17.                        )
18.             )
19.  )
20.  
21.  (If (> (- EP SP) TOL)
22.   (FurthestParameter
23.    (If (< (Nth (Car dist) params) (Nth (Cadr dist) params))
24.     (Nth (Car dist) params)
25.     (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth (Car dist) params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr dist) params)) 1e-8))
26.      (Nth (Cadr dist) params)
27.      (Nth (Caddr dist) params)
28.     )
29.    )
30.    (If (< (Nth (Car dist) params) (Nth (Cadr dist) params))
31.     (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth (Car dist) params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr dist) params)) 1e-8))
32.      (Nth (Cadr dist) params)
33.      (Nth (Caddr dist) params)
34.     )
35.     (Nth (Car dist) params)
36.    )
37.    TOL
38.   )
39.   (Nth (Car dist) params)
40.  )
41. )
42.  
43. (VLAX-Curve-GetPointAtParam CURVE (FurthestParameter (VLAX-Curve-GetStartParam CURVE) (VLAX-Curve-GetEndParam CURVE) TOL) )
44. )
45.  
46. (defun vlax-curve-getfurthestpointfrom ( ent pt / elst etype )
47.        (setq elst (entget ent))
48.        (cond
49.            (   (= "XLINE" (setq etype (cdr (assoc 0 elst))))
50.                nil
51.            )
52.            (   (= "RAY" (setq etype (cdr (assoc 0 elst))))
53.                nil
54.            )
55.            (   (= "LINE" etype)
56.                (if (< (distance pt (cdr (assoc 10 elst)))
57.                       (distance pt (cdr (assoc 11 elst)))
58.                    )
59.                    (cdr (assoc 11 elst))
60.                    (cdr (assoc 10 elst))
61.                )
62.            )
63.            (   (and
64.                    (= "LWPOLYLINE" etype)
65.                    (vl-every '(lambda ( x ) (or (/= 42 (car x)) (zerop (cdr x)))) elst)
66.                )
67.                (car
68.                    (vl-sort (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) elst))
69.                        (function
70.                            (lambda ( a b ) (> (distance pt a) (distance pt b)))
71.                        )
72.                    )
73.                )
74.            )
75.            (   t
76.                (ZF-GetFurthestPointFrom ent pt 1e-8)
77.            )
78.        )
79. )
80.  

P.S. You must use (vl-load-com) before lake every other vlax-curve-function...

M.R. :-)

Title: Re: vlax-curve-getfurthestpointfrom
Post by: Kerry on July 13, 2012, 01:26:26 AM

just to be pedantic ...
The vla-, vlax- naming prefix is recognised as the naming convention used by Visual Lisp library functions.

I'd prefer to see a different prefix if the code was to be used on one of my machines.


Regards
kdub.



ps:
probably best not to use kdub:xxxx or kdub-xxxx either   :-)

Title: Re: vlax-curve-getfurthestpointfrom
Post by: zoltan on July 13, 2012, 07:47:00 AM

Quote from: Kerry on July 13, 2012, 01:26:26 AM

The vla-, vlax- naming prefix is recognised as the naming convention used by Visual Lisp library functions.

I felt that way too, just decided it was not important enough to mention.  I think we should make it a convention of TheSwamp to always have the name of functions that you post be prefixed with you user name or initials.  That way, when multiple users post various solutions to the same problem, posters can refer to the different functions by name.

Here is a post which gives a good example:
http://www.theswamp.org/index.php?topic=42122.msg473506#msg473506
 

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on July 13, 2012, 08:18:20 AM

Zoltan, I agree, but this is an exeption - intension was to make real programmers to revide VisualLisp functions as this one was missed... BTW., I've changed your code - little modification as with circle and outside point gave wrong results (it searched for start point of circle, where both start and end parameters gave maximum distance and parameters were sorted so that these were solution to the return value; also changed fuzz factor little more acceptable not to come to hard error)...

M.R.

Title: Re: vlax-curve-getfurthestpointfrom
Post by: BlackBox on July 13, 2012, 08:43:36 AM

Quote from: ribarm on July 13, 2012, 08:18:20 AM

Zoltan, I agree, but this is an exeption - intension was to make real programmers to revide VisualLisp functions as this one was missed

In that case:

Code - Auto/Visual Lisp: [Select]

1. ;;;--------------------------------------------------------------------;
2. ;;; Unprotect symbols:
3. (pragma '((unprotect-assign vlax-Curve-GetFurthestPointFrom)))
4. ;;;--------------------------------------------------------------------;
5. (defun vlax-Curve-GetFurthestPointFrom ()
6.   ;; <-- blah  
7.   )
8. ;;;--------------------------------------------------------------------;
9. ;;; Protect symbols:
10. (pragma '((protect-assign vlax-Curve-GetFurthestPointFrom)))
11.  

... Or, one can always hop into Visual Studio and code an actual LispFunction Method.  ;-)

Title: Re: vlax-curve-getfurthestpointfrom
Post by: PKENEWELL on July 13, 2012, 10:47:42 AM

Quote from: ribarm on July 13, 2012, 01:15:52 AM

Thank you Lee very much... Only skipped "RAY", so my final function with acceptable tolerance for almost if not exact result is 1e-8...

Code - Auto/Visual Lisp: [Select]

1. (Defun ZF-GetFurthestPointFrom (CURVE POINT TOL / FurthestParameter )
2. (Defun FurthestParameter (SP EP TOL / params dist )
3.  (SetQ params (List SP
4.                     (+ SP (* (- EP SP) (/ 1.0 3.0)) )
5.                     (+ SP (* (- EP SP) (/ 2.0 3.0)) )
6.                     EP
7.               )
8.  )
9.  
10.  (SetQ dist (Vl-Sort-I params
11.                        (Function
12.                         (Lambda (a b)
13.                          (>= (Distance POINT (VLAX-Curve-GetPointAtParam CURVE a))
14.                              (Distance POINT (VLAX-Curve-GetPointAtParam CURVE b))
15.                          )
16.                         )
17.                        )
18.             )
19.  )
20.  
21.  (If (> (- EP SP) TOL)
22.   (FurthestParameter
23.    (If (< (Nth (Car dist) params) (Nth (Cadr dist) params))
24.     (Nth (Car dist) params)
25.     (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth (Car dist) params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr dist) params)) 1e-8))
26.      (Nth (Cadr dist) params)
27.      (Nth (Caddr dist) params)
28.     )
29.    )
30.    (If (< (Nth (Car dist) params) (Nth (Cadr dist) params))
31.     (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth (Car dist) params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr dist) params)) 1e-8))
32.      (Nth (Cadr dist) params)
33.      (Nth (Caddr dist) params)
34.     )
35.     (Nth (Car dist) params)
36.    )
37.    TOL
38.   )
39.   (Nth (Car dist) params)
40.  )
41. )
42.  
43. (VLAX-Curve-GetPointAtParam CURVE (FurthestParameter (VLAX-Curve-GetStartParam CURVE) (VLAX-Curve-GetEndParam CURVE) TOL) )
44. )
45.  
46. (defun vlax-curve-getfurthestpointfrom ( ent pt / elst etype )
47.        (setq elst (entget ent))
48.        (cond
49.            (   (= "XLINE" (setq etype (cdr (assoc 0 elst))))
50.                nil
51.            )
52.            (   (= "RAY" (setq etype (cdr (assoc 0 elst))))
53.                nil
54.            )
55.            (   (= "LINE" etype)
56.                (if (< (distance pt (cdr (assoc 10 elst)))
57.                       (distance pt (cdr (assoc 11 elst)))
58.                    )
59.                    (cdr (assoc 11 elst))
60.                    (cdr (assoc 10 elst))
61.                )
62.            )
63.            (   (and
64.                    (= "LWPOLYLINE" etype)
65.                    (vl-every '(lambda ( x ) (or (/= 42 (car x)) (zerop (cdr x)))) elst)
66.                )
67.                (car
68.                    (vl-sort (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) elst))
69.                        (function
70.                            (lambda ( a b ) (> (distance pt a) (distance pt b)))
71.                        )
72.                    )
73.                )
74.            )
75.            (   t
76.                (ZF-GetFurthestPointFrom (vlax-ename->vla-object ent) pt 1e-8)
77.            )
78.        )
79. )
80.  

P.S. You must use (vl-load-com) before lake every other vlax-curve-function...

M.R. :-)

@ribarm:

Nice code! One slight issue - when you call all the "vlax-curve" functions you need to supply your "CURVE" argument as a VLA-Object, rather than an entity name
I corrected your call to "ZF-GetFurthestPointFrom" in the quote above to use (vlax-ename->vla-object ent).

- Phil

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on July 13, 2012, 11:00:48 AM

If you didn't noticed vlax-curve-functions don't need VLA-OBJECT as argument - it is totally acceptable for argument to be ENAME... And no it's not nice code at all, it only works for circle and point that is not center and gives approx. correct result, but in all other cases of curves and I mean real curves not line, pline, xline... it will probably fail... This topic is only ilustrative - to point out that there is important missing vlax-curve function in VLisp... And who will provide solution, real one with exact return value like vlax-curve-getclosestpointto, I don't know, suppose the one that made vlax-curve-getclosestpointto (I would change sign of evaluating distances from < to > and I mean that this is probably the case... Only thing is how to make that someone that knows to do that to really do that...

All best, sincerely M.R. (arch. not programmer) (I know that I've tried, and maybe my effort won't be pointless)

Title: Re: vlax-curve-getfurthestpointfrom
Post by: BlackBox on July 13, 2012, 11:17:51 AM

Quote from: PKENEWELL on July 13, 2012, 10:47:42 AM

@ribarm:

Nice code! One slight issue - when you call all the "vlax-curve" functions you need to supply your "CURVE" argument as a VLA-Object, rather than an entity name

@Phil - Your statement, and the developer documentation, are both incorrect.

Vlax-Curve-* functions _do_ accept both Vla-Object* and Ename as an acceptable argument... Try it for yourself.

** Edit - I made the same mistake when I started learning Vl* code. It happens.

Quote from: PKENEWELL on July 13, 2012, 10:47:42 AM

I corrected your call to "ZF-GetFurthestPointFrom" in the quote above to use (vlax-ename->vla-object ent).

@Phil - Instead of correcting another's code when quoting them, consider posting _your own_ code block, as changing another's words/code, etc. is misleading.

** Edit - I don't believe this was your intention. Just trying to help.

Quote from: ribarm on July 13, 2012, 11:00:48 AM

All best, sincerely M.R. (arch. not programmer) (I know that I've tried, and maybe my effort won't be pointless)

@Marco -

Don't take it personal, my friend; you well know that we appreciate your programming efforts, and attempt(s) to further (no pun intended) the Visual LISP code library of sorts.

Cheers! :beer:

Title: Re: vlax-curve-getfurthestpointfrom
Post by: PKENEWELL on July 13, 2012, 11:21:45 AM

Quote from: ribarm on July 13, 2012, 11:00:48 AM

If you didn't noticed vlax-curve-functions don't need VLA-OBJECT as argument - it is totally acceptable for argument to be ENAME... And no it's not nice code at all, it only works for circle and point that is not center and gives approx. correct result, but in all other cases of curves and I mean real curves not line, pline, xline... it will probably fail... This topic is only ilustrative - to point out that there is important missing vlax-curve function in VLisp... And who will provide solution, real one with exact return value like vlax-curve-getclosestpointto, I don't know, suppose the one that made vlax-curve-getclosestpointto (I would change sign of evaluating distances from < to > and I mean that this is probably the case... Only thing is how to make that someone that knows to do that to really do that...

All best, sincerely M.R. (arch. not programmer) (I know that I've tried, and maybe my effort won't be pointless)

 :-( Sorry. Guess I should've tested it more, but It did work nicely on the spline I tried it on. Forgive me for trying to give a compliment...  :ugly:

Also - I always assumed that the (vlax-curve... functions excepted only a VLA-object since that is what the argument refers to in AutoCAD's developer help and never tried putting and entity name on them. Since I always proof read code before trying it, I just made the correction and I did not realize they would also take an ENAME as well - thanks for the bit of knowledge.

- Phil.

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ronjonp on July 13, 2012, 11:27:16 AM

If I remember correctly, the performance of supplying an ename over a vla-object is quite significant too  8-)

Title: Re: vlax-curve-getfurthestpointfrom
Post by: zoltan on July 13, 2012, 11:38:55 AM

Quote from: ribarm on July 13, 2012, 01:15:52 AM

Thank you Lee very much... Only skipped "RAY", so my final function with acceptable tolerance for almost if not exact result is 1e-8...

ribarm , You are still recursing the function between the furthest test point and the second furthest test point as in your first example.  You should be recursing between the test point before the furthest test point and the test point after the furthest test point.

Look again at the curve in the example I posted here:
http://www.theswamp.org/index.php?topic=42246.msg473876#msg473876

If the actual furthest point is not between the furthest and second furthest test points, it will produce incorrect results.

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on July 13, 2012, 01:27:44 PM

Zoltan, it doesn't matter between witch points routine performs recursion, as there are cases where this method isn't good...
Look in picture I uploaded and you'll see that this method is useless... Only way to find correct result is to check every point or param. on curve.
I suppose this is how (vlax-curve-getclosestpointto) works, and only thing that should be done is inverse algorithm for vlax-curve-getclosestpointto to check distances that are > - larger, rather then < - smaller...

I've deliberately put my version into code to point that code isn't working...

M.R.

Title: Re: vlax-curve-getfurthestpointfrom
Post by: zoltan on July 13, 2012, 02:24:54 PM

Quote from: ribarm on July 13, 2012, 01:27:44 PM

Zoltan, it doesn't matter between witch points routine performs recursion, as there are cases where this method isn't good...
Look in picture I uploaded and you'll see that this method is useless... Only way to find correct result is to check every point or param. on curve.

I see.  This problem just got more interesting.

It is not possible to test every parameter on the curve, because there is an infinite number of them (well, as many as there are real numbers in Lisp).  The divide-and-concur method should still work if we dividing the cure into many more points than just 4.  We will have to think of a logic to determine the number of points to give the best trade-off between speed and accuracy.

Title: Re: vlax-curve-getfurthestpointfrom
Post by: BlackBox on July 13, 2012, 03:04:04 PM

Quote from: zoltan on July 13, 2012, 02:24:54 PM

Quote from: ribarm on July 13, 2012, 01:27:44 PM

Zoltan, it doesn't matter between witch points routine performs recursion, as there are cases where this method isn't good...
Look in picture I uploaded and you'll see that this method is useless... Only way to find correct result is to check every point or param. on curve.

I see.  This problem just got more interesting.

It is not possible to test every parameter on the curve, because there is an infinite number of them (well, as many as there are real numbers in Lisp).  The divide-and-concur method should still work if we dividing the cure into many more points than just 4.  We will have to think of a logic to determine the number of points to give the best trade-off between speed and accuracy.

Agreed; after ronjon's hint back on the first page I realized that this was going to be heavily dependent on precision. Perhaps as a starting point, we can use the ActiveDocument's current LUPREC (http://exchange.autodesk.com/autocad/enu/online-help/browse#WS1a9193826455f5ffa23ce210c4a30acaf-4f54.htm) value?

Also worthy of consideration, is mitigating the potential to overload the Stack (perhaps GC (http://exchange.autodesk.com/autocad/enu/online-help/browse#WS1a9193826455f5ff1a32d8d10ebc6b7ccc-6a18.htm) will help?).   :?

Otherwise, we'd need to use Linq + Lambda in .NET (to minimize the iterations to calculate result), no? Example (http://www.theswamp.org/index.php?topic=41911.0) (Sorry, you'll have to read through, don't have time to find exact post).

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on July 13, 2012, 03:25:12 PM

Vl-sort-i or vl-sort seems can't handle more elements in a list...

This isn't working also :

Code: [Select]

(Defun ZF-GetFurthestPointFrom (CURVE POINT TOL / FurthestParameter )
(Defun FurthestParameter (SP EP TOL / params dist )
 (SetQ params (List SP
                    (+ SP (* (- EP SP) (/ 1.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 2.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 3.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 4.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 5.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 6.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 7.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 8.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 9.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 10.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 11.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 12.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 13.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 14.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 15.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 16.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 17.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 18.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 19.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 20.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 21.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 22.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 23.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 24.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 25.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 27.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 28.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 29.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 30.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 31.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 32.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 33.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 34.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 35.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 36.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 37.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 38.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 39.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 40.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 41.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 42.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 43.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 44.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 45.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 46.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 47.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 48.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 49.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 50.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 51.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 52.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 53.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 54.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 55.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 56.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 57.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 58.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 59.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 60.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 61.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 62.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 63.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 64.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 65.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 66.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 67.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 68.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 69.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 70.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 71.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 72.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 73.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 74.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 75.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 76.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 77.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 78.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 79.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 80.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 81.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 82.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 83.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 84.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 85.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 86.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 87.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 88.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 89.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 90.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 91.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 92.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 93.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 94.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 95.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 96.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 97.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 98.0 100.0)) )
                    (+ SP (* (- EP SP) (/ 99.0 100.0)) )
                    EP
              )
 )
 
 (SetQ dist (Vl-Sort-I params
                       (Function
                        (Lambda (a b)
                         (>= (Distance POINT (VLAX-Curve-GetPointAtParam CURVE a))
                             (Distance POINT (VLAX-Curve-GetPointAtParam CURVE b))
                         )
                        )
                       )
            )
 )
 
 (If (> (- EP SP) TOL)
  (FurthestParameter
   (If (< (Nth (Car dist) params) (Nth (Cadr dist) params))
    (Nth (Car dist) params)
    (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth (Car dist) params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr dist) params)) 1e-8))
     (Nth (Cadr dist) params)
     (Nth (Caddr dist) params)
    )
   )
   (If (< (Nth (Car dist) params) (Nth (Cadr dist) params))
    (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth (Car dist) params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr dist) params)) 1e-8))
     (Nth (Cadr dist) params)
     (Nth (Caddr dist) params)
    )
    (Nth (Car dist) params)
   )
   TOL
  )
  (Nth (Car dist) params)
 )
)
 
(VLAX-Curve-GetPointAtParam CURVE (FurthestParameter (VLAX-Curve-GetStartParam CURVE) (VLAX-Curve-GetEndParam CURVE) TOL) )
)

(defun vlax-curve-getfurthestpointfrom ( ent pt / elst etype )
       (setq elst (entget ent))
       (cond
           (   (= "XLINE" (setq etype (cdr (assoc 0 elst))))
               nil
           )
           (   (= "RAY" (setq etype (cdr (assoc 0 elst))))
               nil
           )
           (   (= "LINE" etype)
               (if (< (distance pt (cdr (assoc 10 elst)))
                      (distance pt (cdr (assoc 11 elst)))
                   )
                   (cdr (assoc 11 elst))
                   (cdr (assoc 10 elst))
               )
           )
           (   (and
                   (= "CIRCLE" etype)
                   (equal pt (cdr (assoc 10 elst)) 1e-8)
               )
               (polar pt 0.0 (cdr (assoc 40 elst)))
           )
           (   (and
                   (= "ELLIPSE" etype)
                   (equal pt (cdr (assoc 10 elst)) 1e-8)
               )
               (ZF-GetFurthestPointFrom ent (mapcar '+ pt (list 1e-2 1e-2 0.0)) 1e-8)
           )
           (   (and
                   (= "LWPOLYLINE" etype)
                   (vl-every '(lambda ( x ) (or (/= 42 (car x)) (zerop (cdr x)))) elst)
               )
               (car
                   (vl-sort (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) elst))
                       (function
                           (lambda ( a b ) (> (distance pt a) (distance pt b)))
                       )
                   )
               )
           )
           (   t
               (ZF-GetFurthestPointFrom ent pt 1e-8)
           )
       )
)

M.R.
 :cry:

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on July 13, 2012, 03:31:25 PM

I don't know in previous ACAD session it didn't work, and now it works...

Strange, Friday 13th symptom...
 :-o

M.R.

Title: Re: vlax-curve-getfurthestpointfrom
Post by: zoltan on July 13, 2012, 06:09:55 PM

Code - Auto/Visual Lisp: [Select]

1. (Defun ZF-Curve-GetFurthestPointFrom ( CURVE POINT / samples tolerance IsFurther FurthestParameter elst etype cent rad vec mag)
2.  (SetQ samples 100
3.        tolerance 1e-10
4.  )
5.  
6.  (Defun IsFurther ( A B P )
7.   (> (Distance A P) (Distance B P))
8.  )
9.  
10.  (Defun FurthestParameter (SP EP / seg params furthest )
11.   (SetQ params (List SP))
12.   (SetQ seg 0.0)
13.  
14.   (Repeat (1- samples)
15.    (SetQ params (Cons (+ SP (SetQ seg (+ seg (/ (- EP SP) samples)))) params))
16.   )
17.  
18.   (SetQ furthest (Car
19.                   (Vl-Sort-I
20.                    params
21.                    (Function
22.                     (Lambda (a b)
23.                      (IsFurther
24.                       (VLAX-Curve-GetPointAtParam CURVE a)
25.                       (VLAX-Curve-GetPointAtParam CURVE b)
26.                       POINT
27.                      )
28.                     )
29.                    )
30.                   )
31.                  )
32.   )
33.  
34.   (If (> (- (VLAX-Curve-GetDistAtParam CURVE EP) (VLAX-Curve-GetDistAtParam CURVE SP)) tolerance)
35.    (FurthestParameter
36.     (If (= furthest 0)
37.      (Nth furthest params)
38.      (Nth (1- furthest) params)
39.      )
40.     (If (= furthest (1- (Length params)))
41.      (Nth furthest params)
42.      (Nth (1+ furthest) params)
43.      )
44.     )
45.    (Nth furthest params)
46.   )
47.  )
48.  
49.  (SetQ elst (entget CURVE))
50.  
51.  (Cond
52.   ((= "XLINE" (SetQ etype (Cdr (Assoc 0 elst))))
53.    nil
54.   )
55.   ((= "RAY" etype)
56.    nil
57.   )
58.   ((= "LINE" etype)
59.    (If (IsFurther (Cdr (Assoc 10 elst)) (Cdr (Assoc 11 elst)) POINT)
60.     (Cdr (Assoc 10 elst))
61.     (Cdr (Assoc 11 elst))
62.    )
63.   )
64.   ((= "CIRCLE" etype)
65.    (If (Equal POINT (SetQ cent (Cdr (Assoc 10 elst))))
66.     nil
67.     (ProgN
68.      (SetQ rad (Cdr (Assoc 40 elst)) )
69.      (SetQ vec (List (- (Car cent) (Car POINT)) (- (Cadr cent) (Cadr POINT)) (- (Caddr cent) (Caddr POINT))))
70.      (SetQ mag (Sqrt (+ (* (Car vec) (Car vec)) (* (Cadr vec) (Cadr vec)) (* (Caddr vec) (Caddr vec)))))
71.      (List (+ (Car cent) (* (/ (Car vec) mag) rad)) (+ (Cadr cent) (* (/ (Cadr vec) mag) rad)) (+ (Caddr cent) (* (/ (Caddr vec) mag) rad)))
72.     )
73.    )
74.   )
75.   ((And
76.     (= "LWPOLYLINE" etype)
77.     (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst)
78.    )
79.    (Car
80.     (VL-Sort (MapCar (Function Cdr) (VL-Remove-If-Not (Function (Lambda ( x ) (= 10 (Car x)))) elst))
81.              (Function (Lambda ( a b ) (IsFurther a b POINT)) )
82.     )
83.    )
84.   )
85.   (T
86.    (VLAX-Curve-GetPointAtParam
87.     CURVE
88.     (FurthestParameter
89.      (VLAX-Curve-GetStartParam CURVE)
90.      (VLAX-Curve-GetEndParam CURVE)
91.     )
92.    )
93.   )
94.  )
95. )
96.  

I still need to come up with a way to reliably determine the number of samples and tolerance from the length of the curve or something.

 I also added a case for circles, because they have a closed form solution that does not require approximation.  I'm afraid, however, that it will not work correctly if the input point is not planar to the circle.

Title: Re: vlax-curve-getfurthestpointfrom
Post by: Lee Mac on July 13, 2012, 07:24:50 PM

Some alternatives for the Circle solution:

Code - Auto/Visual Lisp: [Select]

1. (   (= "CIRCLE" etype)
2.     (if (not (equal point (setq cen (cdr (assoc 10 elst)))))
3.         (progn
4.             (setq d (/ (cdr (assoc 40 elst)) (distance point cen)))
5.             (mapcar (function (lambda ( a b ) (+ a (* b d)))) cen (mapcar '- cen point))
6.         )
7.     )
8. )

Code - Auto/Visual Lisp: [Select]

1. (   (= "CIRCLE" etype)
2.     (if (not (equal point (setq cen (cdr (assoc 10 elst)))))
3.         (polar cen (angle point cen) (cdr (assoc 40 elst)))
4.     )
5. )

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on July 14, 2012, 01:16:56 AM

Based on Zoltan's code, here is mine version - my recursion between 2 furthest points... And look for CIRCLE and ELLIPSE solutions (main routine should calc. result) - only exception is when point is center, then I changed little center point, just slightly translation, so that main routine can calc. result...

Code - Auto/Visual Lisp: [Select]

1. (Defun MR-Curve-GetFurthestPointFrom ( CURVE POINT / samples tolerance IsFurther FurthestParameter elst etype cent rad vec mag)
2. (SetQ samples 200
3.      tolerance 1e-8
4. )
5.  
6. (Defun FurthestParameter (SP EP / seg params par furthest )
7. (SetQ params (List SP))
8. (SetQ seg 0.0)
9.  
10. (Defun IsFurther ( A B P )
11.  (>= (Distance A P) (Distance B P))
12. )
13.  
14. (Repeat (1- samples)
15.  (SetQ params (Cons (+ SP (SetQ seg (+ seg (/ (- EP SP) samples)))) params))
16. )
17.  
18. (SetQ furthest (Car (SetQ par
19.                 (Vl-Sort-I
20.                  params
21.                  (Function
22.                   (Lambda (a b)
23.                    (IsFurther
24.                     (VLAX-Curve-GetPointAtParam CURVE a)
25.                     (VLAX-Curve-GetPointAtParam CURVE b)
26.                     POINT
27.                    )
28.                   )
29.                  )
30.                 ))
31.                )
32. )
33.  
34. (If (> (- (VLAX-Curve-GetDistAtParam CURVE EP) (VLAX-Curve-GetDistAtParam CURVE SP)) tolerance)
35.  (FurthestParameter
36.   (If (< (Nth furthest params) (Nth (Cadr par) params))
37.    (Nth furthest params)
38.    (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth furthest params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr par) params)) 1e-8))
39.     (Nth (Cadr par) params)
40.     (Nth (Caddr par) params)
41.    )
42.   )
43.   (If (< (Nth furthest params) (Nth (Cadr par) params))
44.    (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth furthest params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr par) params)) 1e-8))
45.     (Nth (Cadr par) params)
46.     (Nth (Caddr par) params)
47.    )
48.    (Nth furthest params)
49.   )
50.  )
51.  (Nth furthest params)
52. )
53. )
54.  
55.  (VLAX-Curve-GetPointAtParam
56.   CURVE
57.   (FurthestParameter
58.    (VLAX-Curve-GetStartParam CURVE)
59.    (VLAX-Curve-GetEndParam CURVE)
60.   )
61.  )
62.  
63. )
64.  
65. (defun vlax-curve-getfurthestpointfrom ( CURVE POINT / elst etype 2dtype lstn )
66.  
67. (Defun IsFurther ( A B P )
68.  (>= (Distance A P) (Distance B P))
69. )
70.  
71. (defun _polyvertices ( lst )
72.   (_vertices2 (entnext (cdr (assoc -1 lst))))
73. )
74.  
75. (defun _vertices2 ( e )
76.   (if (eq "VERTEX" (cdr (assoc 0 (entget e))))
77.     (progn
78.       (setq lstn (cons (assoc 10 (entget e)) lstn))
79.       (setq lstn (cons (assoc 42 (entget e)) lstn))
80.       (_vertices2 (entnext e))
81.     )
82.   )
83.   (reverse lstn)
84. )
85.  
86. (defun member-fuzz (expr lst fuzz)
87.   (while (and lst (not (equal (car lst) expr fuzz)))
88.     (setq lst (cdr lst))
89.   )
90.   lst
91. )
92.  
93. (defun _plcents ( ent / enpar n p1 p2 bulge rad cen cenlst )
94.   (setq enpar (vlax-curve-getendparam ent))
95.   (setq n -1)
96.   (repeat (fix enpar)
97.     (setq n (1+ n))
98.     (setq p1 (vlax-curve-getpointatparam ent (float n)))
99.     (setq p2 (vlax-curve-getpointatparam ent (float (1+ n))))
100.     (setq bulge (vla-getbulge (vlax-ename->vla-object ent) (float n)))
101.     (if (/= bulge 0.0)
102.       (progn
103.         (setq rad (/ (distance p1 p2) (* 2 (sin (* 2 (atan bulge))))))
104.         (setq cen (polar p1 (+ (angle p1 p2) (- (/ pi 2.0) (* 2 (atan bulge)))) rad))
105.         (setq cenlst (cons cen cenlst))
106.       )
107.     )
108.   )
109.   (reverse cenlst)
110. )
111.  
112. (SetQ elst (entget CURVE))
113. (SetQ etype (Cdr (Assoc 0 elst)))
114.  
115. (Cond
116. ((= "XLINE" etype)
117.  nil
118. )
119. ((= "RAY" etype)
120.  nil
121. )
122. ((= "LINE" etype)
123.  (If (IsFurther (Cdr (Assoc 10 elst)) (Cdr (Assoc 11 elst)) POINT)
124.   (Cdr (Assoc 10 elst))
125.   (Cdr (Assoc 11 elst))
126.  )
127. )
128. ((And
129.   (= "ARC" etype)
130.   (Equal POINT (Cdr (Assoc 10 elst)) 1e-8)
131.  )
132.  (MR-Curve-GetFurthestPointFrom CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
133. )
134. ((And
135.   (= "CIRCLE" etype)
136.   (Equal POINT (Cdr (Assoc 10 elst)) 1e-8)
137.  )
138.  (MR-Curve-GetFurthestPointFrom CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
139. )
140. ((And
141.   (= "ELLIPSE" etype)
142.   (Equal POINT (Cdr (Assoc 10 elst)) 1e-8)
143.  )
144.  (MR-Curve-GetFurthestPointFrom CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
145. )
146. ((And
147.   (= "LWPOLYLINE" etype)
148.   (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst)
149.  )
150.  (Car
151.   (VL-Sort (MapCar (Function Cdr) (VL-Remove-If-Not (Function (Lambda ( x ) (= 10 (Car x)))) elst))
152.            (Function (Lambda ( a b ) (IsFurther a b POINT)) )
153.   )
154.  )
155. )
156. ((And
157.   (= "LWPOLYLINE" etype)
158.   (not (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst))
159.   (member-fuzz POINT (_plcents CURVE) 1e-8)
160.  )
161.  (MR-Curve-GetFurthestPointFrom CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
162. )
163. ((And
164.   (= "POLYLINE" etype)
165.   (SetQ 2dtype (Cdr (Assoc 100 (Reverse elst))))
166.   (SetQ elst (_polyvertices elst))
167.   (not (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst))
168.   (If (= 2dtype "AcDb2dPolyline") (member-fuzz POINT (_plcents CURVE) 1e-8))
169.  )
170.  (MR-Curve-GetFurthestPointFrom CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
171. )
172. ((And
173.   (= "POLYLINE" etype)
174.   (not (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst))
175.  )
176.  (MR-Curve-GetFurthestPointFrom CURVE POINT)
177. )
178. ((And
179.   (= "POLYLINE" etype)
180.   (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst)
181.  )
182.  (Car
183.   (VL-Sort (MapCar (Function Cdr) (VL-Remove-If-Not (Function (Lambda ( x ) (= 10 (Car x)))) elst))
184.            (Function (Lambda ( a b ) (IsFurther a b POINT)) )
185.   )
186.  )
187. )
188. (T
189.  (MR-Curve-GetFurthestPointFrom CURVE POINT)
190. )
191. )
192. )
193.  

P.S. I like your way of dealing with tolerances and enlarging list of parameters with segmentation... BTW I took 200 samples, tolerance 1e-8...

M.R.

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on July 15, 2012, 05:41:12 AM

The more time passes, I figure that both logics and mine and Zoltans have their benefits... So I combined them into one single function (vlax-curve-getfurthestpointfrom) - for now I couldn't think of better name as it describes what should real missing VLisp function do...

Code - Auto/Visual Lisp: [Select]

1. (Defun ZF-Curve-GetFurthestPointFrom ( CURVE POINT / samples tolerance IsFurther FurthestParameter elst etype cent rad vec mag)
2. (SetQ samples 200
3.      tolerance 1e-8
4. )
5.  
6. (Defun FurthestParameter (SP EP / seg params par furthest )
7. (SetQ params (List SP))
8. (SetQ seg 0.0)
9.  
10. (Defun IsFurther ( A B P )
11.  (>= (Distance A P) (Distance B P))
12. )
13.  
14. (Repeat (1- samples)
15.  (SetQ params (Cons (+ SP (SetQ seg (+ seg (/ (- EP SP) samples)))) params))
16. )
17.  
18. (SetQ furthest (Car (SetQ par
19.                 (Vl-Sort-I
20.                  params
21.                  (Function
22.                   (Lambda (a b)
23.                    (IsFurther
24.                     (VLAX-Curve-GetPointAtParam CURVE a)
25.                     (VLAX-Curve-GetPointAtParam CURVE b)
26.                     POINT
27.                    )
28.                   )
29.                  )
30.                 ))
31.                )
32. )
33.  
34. (If (> (- (VLAX-Curve-GetDistAtParam CURVE EP) (VLAX-Curve-GetDistAtParam CURVE SP)) tolerance)
35.  (FurthestParameter
36.   (If (< (Nth (Cadr par) params) (Nth (Caddr par) params))
37.    (Nth (Cadr par) params)
38.    (Nth (Caddr par) params)
39.   )
40.   (If (< (Nth (Cadr par) params) (Nth (Caddr par) params))
41.    (Nth (Caddr par) params)
42.    (Nth (Cadr par) params)
43.   )
44.  )
45.  (Nth furthest params)
46. )
47. )
48.  
49.  (VLAX-Curve-GetPointAtParam
50.   CURVE
51.   (FurthestParameter
52.    (VLAX-Curve-GetStartParam CURVE)
53.    (VLAX-Curve-GetEndParam CURVE)
54.   )
55.  )
56.  
57. )
58.  
59.  
60. (Defun MR-Curve-GetFurthestPointFrom ( CURVE POINT / samples tolerance IsFurther FurthestParameter elst etype cent rad vec mag)
61. (SetQ samples 200
62.      tolerance 1e-8
63. )
64.  
65. (Defun FurthestParameter (SP EP / seg params par furthest )
66. (SetQ params (List SP))
67. (SetQ seg 0.0)
68.  
69. (Defun IsFurther ( A B P )
70.  (>= (Distance A P) (Distance B P))
71. )
72.  
73. (Repeat (1- samples)
74.  (SetQ params (Cons (+ SP (SetQ seg (+ seg (/ (- EP SP) samples)))) params))
75. )
76.  
77. (SetQ furthest (Car (SetQ par
78.                 (Vl-Sort-I
79.                  params
80.                  (Function
81.                   (Lambda (a b)
82.                    (IsFurther
83.                     (VLAX-Curve-GetPointAtParam CURVE a)
84.                     (VLAX-Curve-GetPointAtParam CURVE b)
85.                     POINT
86.                    )
87.                   )
88.                  )
89.                 ))
90.                )
91. )
92.  
93. (If (> (- (VLAX-Curve-GetDistAtParam CURVE EP) (VLAX-Curve-GetDistAtParam CURVE SP)) tolerance)
94.  (FurthestParameter
95.   (If (< (Nth furthest params) (Nth (Cadr par) params))
96.    (Nth furthest params)
97.    (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth furthest params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr par) params)) 1e-8))
98.     (Nth (Cadr par) params)
99.     (Nth (Caddr par) params)
100.    )
101.   )
102.   (If (< (Nth furthest params) (Nth (Cadr par) params))
103.    (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth furthest params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr par) params)) 1e-8))
104.     (Nth (Cadr par) params)
105.     (Nth (Caddr par) params)
106.    )
107.    (Nth furthest params)
108.   )
109.  )
110.  (Nth furthest params)
111. )
112. )
113.  
114.  (VLAX-Curve-GetPointAtParam
115.   CURVE
116.   (FurthestParameter
117.    (VLAX-Curve-GetStartParam CURVE)
118.    (VLAX-Curve-GetEndParam CURVE)
119.   )
120.  )
121.  
122. )
123.  
124. (defun vlax-curve-getfurthestpointfrom ( CURVE POINT / elst etype 2dtype lstn )
125.  
126. (Defun IsFurther ( A B P )
127.  (>= (Distance A P) (Distance B P))
128. )
129.  
130. (defun _polyvertices ( lst )
131.   (_vertices2 (entnext (cdr (assoc -1 lst))))
132. )
133.  
134. (defun _vertices2 ( e )
135.   (if (eq "VERTEX" (cdr (assoc 0 (entget e))))
136.     (progn
137.       (setq lstn (cons (assoc 10 (entget e)) lstn))
138.       (setq lstn (cons (assoc 42 (entget e)) lstn))
139.       (_vertices2 (entnext e))
140.     )
141.   )
142.   (reverse lstn)
143. )
144.  
145. (defun member-fuzz (expr lst fuzz)
146.   (while (and lst (not (equal (car lst) expr fuzz)))
147.     (setq lst (cdr lst))
148.   )
149.   lst
150. )
151.  
152. (defun _plcents ( ent / enpar n p1 p2 bulge rad cen cenlst )
153.   (setq enpar (vlax-curve-getendparam ent))
154.   (setq n -1)
155.   (repeat (fix enpar)
156.     (setq n (1+ n))
157.     (setq p1 (vlax-curve-getpointatparam ent (float n)))
158.     (setq p2 (vlax-curve-getpointatparam ent (float (1+ n))))
159.     (setq bulge (vla-getbulge (vlax-ename->vla-object ent) (float n)))
160.     (if (/= bulge 0.0)
161.       (progn
162.         (setq rad (/ (distance p1 p2) (* 2 (sin (* 2 (atan bulge))))))
163.         (setq cen (polar p1 (+ (angle p1 p2) (- (/ pi 2.0) (* 2 (atan bulge)))) rad))
164.         (setq cenlst (cons cen cenlst))
165.       )
166.     )
167.   )
168.   (reverse cenlst)
169. )
170.  
171. (SetQ elst (entget CURVE))
172. (SetQ etype (Cdr (Assoc 0 elst)))
173.  
174. (Cond
175. ((= "XLINE" etype)
176.  nil
177. )
178. ((= "RAY" etype)
179.  nil
180. )
181. ((= "LINE" etype)
182.  (If (IsFurther (Cdr (Assoc 10 elst)) (Cdr (Assoc 11 elst)) POINT)
183.   (Cdr (Assoc 10 elst))
184.   (Cdr (Assoc 11 elst))
185.  )
186. )
187. ((And
188.   (= "ARC" etype)
189.   (Equal POINT (Cdr (Assoc 10 elst)) 1e-8)
190.  )
191.  (MR-Curve-GetFurthestPointFrom CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
192. )
193. ((And
194.   (= "CIRCLE" etype)
195.   (Equal POINT (Cdr (Assoc 10 elst)) 1e-8)
196.  )
197.  (MR-Curve-GetFurthestPointFrom CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
198. )
199. ((And
200.   (= "ELLIPSE" etype)
201.   (Equal POINT (Cdr (Assoc 10 elst)) 1e-8)
202.  )
203.  (MR-Curve-GetFurthestPointFrom CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
204. )
205. ((And
206.   (= "LWPOLYLINE" etype)
207.   (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst)
208.  )
209.  (Car
210.   (VL-Sort (MapCar (Function Cdr) (VL-Remove-If-Not (Function (Lambda ( x ) (= 10 (Car x)))) elst))
211.            (Function (Lambda ( a b ) (IsFurther a b POINT)) )
212.   )
213.  )
214. )
215. ((And
216.   (= "LWPOLYLINE" etype)
217.   (not (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst))
218.   (member-fuzz POINT (_plcents CURVE) 1e-8)
219.  )
220.  (MR-Curve-GetFurthestPointFrom CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
221. )
222. ((And
223.   (= "POLYLINE" etype)
224.   (SetQ 2dtype (Cdr (Assoc 100 (Reverse elst))))
225.   (SetQ elst (_polyvertices elst))
226.   (not (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst))
227.   (If (= 2dtype "AcDb2dPolyline") (member-fuzz POINT (_plcents CURVE) 1e-8))
228.  )
229.  (MR-Curve-GetFurthestPointFrom CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
230. )
231. ((And
232.   (= "POLYLINE" etype)
233.   (not (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst))
234.  )
235.  (MR-Curve-GetFurthestPointFrom CURVE POINT)
236. )
237. ((And
238.   (= "POLYLINE" etype)
239.   (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst)
240.  )
241.  (Car
242.   (VL-Sort (MapCar (Function Cdr) (VL-Remove-If-Not (Function (Lambda ( x ) (= 10 (Car x)))) elst))
243.            (Function (Lambda ( a b ) (IsFurther a b POINT)) )
244.   )
245.  )
246. )
247. ((= "SPLINE" etype)
248.  (ZF-Curve-GetFurthestPointFrom CURVE POINT)
249. )
250. (T
251.  (MR-Curve-GetFurthestPointFrom CURVE POINT)
252. )
253. )
254. )
255.  

Regards, once again M.R.

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on July 15, 2012, 10:00:46 AM

Code updated to cover all possible combinations of CURVE objects and POINT argument...

And not to forget - giving accreditation to Gile for his subfunction (member-fuzz) as it was used in above posted code and it was taken from Giles website... Link is list manipulations - list subfunctions :

Listes (http://gile.pagesperso-orange.fr/LISP/Listes.lsp)

M.R.

Also, many thanks to Lee Mac for participation and his suggestions in this thread... My final code would never been created without his useful help... So all kudos to Lee too...

Marko

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on July 15, 2012, 05:22:43 PM

No use... Still my subfunction is more reliable in finding approx correct solution...

So my final conclusion is updated code :
http://www.theswamp.org/index.php?topic=42246.msg474040#msg474040

or attached *.lsp

M.R.

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on July 16, 2012, 10:45:40 AM

Code corrected once more... No need to convert old heavy 2d polyline to lwpolyline...

Both variants are acceptable, though I suggest smaller one - MR variant...

M.R.

Title: Re: vlax-curve-getfurthestpointfrom
Post by: chlh_jd on July 24, 2012, 02:33:06 AM

For Circle , this way ?

Code: [Select]

((= "CIRCLE" etype)
  ((lambda (p c r)
     (polar p (angle p c) (* 2. r))
   )
    (vlax-curve-getclosestpointto curve point)
    (cdr (Assoc 10 elst))
    (cdr (assoc 40 elst))
  )
)


Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on August 21, 2012, 08:42:04 AM

Quote from: chlh_jd on July 24, 2012, 02:33:06 AM

For Circle , this way ?

Code: [Select]

((= "CIRCLE" etype)
  ((lambda (p c r)
     (polar p (angle p c) (* 2. r))
   )
    (vlax-curve-getclosestpointto curve point)
    (cdr (Assoc 10 elst))
    (cdr (assoc 40 elst))
  )
)


Yes, chlh_jd, that would sure solve the case, but I wonder how no one didn't saw that in my code - Zoltan's also is written (repeat (1- samples) ...), and should be (repeat samples ...)... So here is my slightly modifications :

Code - Auto/Visual Lisp: [Select]

1. (Defun MR-Curve-GetFurthestPointFrom ( CURVE POINT / samples tolerance IsFurther FurthestParameter elst etype cent rad vec mag)
2. (SetQ samples 200
3.      tolerance 1e-14
4. )
5.  
6. (Defun FurthestParameter (SP EP / seg params par furthest f ff )
7. (SetQ params (List SP))
8. (SetQ seg 0.0)
9.  
10. (Defun IsFurther ( A B P )
11.  (>= (Distance A P) (Distance B P))
12. )
13.  
14. (Repeat samples
15.  (SetQ params (Cons (+ SP (SetQ seg (+ seg (/ (- EP SP) samples)))) params))
16. )
17.  
18. (SetQ furthest (Car (SetQ par
19.                 (Vl-Sort-I
20.                  params
21.                  (Function
22.                   (Lambda (a b)
23.                    (IsFurther
24.                     (VLAX-Curve-GetPointAtParam CURVE a)
25.                     (VLAX-Curve-GetPointAtParam CURVE b)
26.                     POINT
27.                    )
28.                   )
29.                  )
30.                 ))
31.                )
32. )
33.  
34. (setq f (nth furthest params))
35.  
36. (If (and (/= f ff) (> (- (VLAX-Curve-GetDistAtParam CURVE EP) (VLAX-Curve-GetDistAtParam CURVE SP)) tolerance))
37.  (setq ff (FurthestParameter
38.   (If (< (Nth furthest params) (Nth (Cadr par) params))
39.    (Nth furthest params)
40.    (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth furthest params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr par) params)) 1e-8))
41.     (Nth (Cadr par) params)
42.     (Nth (Caddr par) params)
43.    )
44.   )
45.   (If (< (Nth furthest params) (Nth (Cadr par) params))
46.    (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth furthest params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr par) params)) 1e-8))
47.     (Nth (Cadr par) params)
48.     (Nth (Caddr par) params)
49.    )
50.    (Nth furthest params)
51.   )
52.  ))
53.  (setq ff (Nth furthest params))
54. )
55.  
56. ff
57. )
58.  
59.  (VLAX-Curve-GetPointAtParam
60.   CURVE
61.   (FurthestParameter
62.    (VLAX-Curve-GetStartParam CURVE)
63.    (VLAX-Curve-GetEndParam CURVE)
64.   )
65.  )
66.  
67. )
68.  
69. (defun vlax-curve-getfurthestpointfrom ( CURVE POINT / elst etype 2dtype lstn )
70.  
71. (Defun IsFurther ( A B P )
72.  (>= (Distance A P) (Distance B P))
73. )
74.  
75. (defun _polyvertices ( lst )
76.   (_vertices2 (entnext (cdr (assoc -1 lst))))
77. )
78.  
79. (defun _vertices2 ( e )
80.   (if (eq "VERTEX" (cdr (assoc 0 (entget e))))
81.     (progn
82.       (setq lstn (cons (assoc 10 (entget e)) lstn))
83.       (setq lstn (cons (assoc 42 (entget e)) lstn))
84.       (_vertices2 (entnext e))
85.     )
86.   )
87.   (reverse lstn)
88. )
89.  
90. (defun member-fuzz (expr lst fuzz)
91.   (while (and lst (not (equal (car lst) expr fuzz)))
92.     (setq lst (cdr lst))
93.   )
94.   lst
95. )
96.  
97. (defun _plcents ( ent / enpar n p1 p2 bulge rad cen cenlst )
98.   (setq enpar (vlax-curve-getendparam ent))
99.   (setq n -1)
100.   (repeat (fix enpar)
101.     (setq n (1+ n))
102.     (setq p1 (vlax-curve-getpointatparam ent (float n)))
103.     (setq p2 (vlax-curve-getpointatparam ent (float (1+ n))))
104.     (setq bulge (vla-getbulge (vlax-ename->vla-object ent) (float n)))
105.     (if (/= bulge 0.0)
106.       (progn
107.         (setq rad (/ (distance p1 p2) (* 2 (sin (* 2 (atan bulge))))))
108.         (setq cen (polar p1 (+ (angle p1 p2) (- (/ pi 2.0) (* 2 (atan bulge)))) rad))
109.         (setq cenlst (cons cen cenlst))
110.       )
111.     )
112.   )
113.   (reverse cenlst)
114. )
115.  
116. (SetQ elst (entget CURVE))
117. (SetQ etype (Cdr (Assoc 0 elst)))
118.  
119. (Cond
120. ((= "XLINE" etype)
121.  nil
122. )
123. ((= "RAY" etype)
124.  nil
125. )
126. ((= "LINE" etype)
127.  (If (IsFurther (Cdr (Assoc 10 elst)) (Cdr (Assoc 11 elst)) POINT)
128.   (Cdr (Assoc 10 elst))
129.   (Cdr (Assoc 11 elst))
130.  )
131. )
132. ((And
133.   (= "ARC" etype)
134.   (Equal POINT (Cdr (Assoc 10 elst)) 1e-8)
135.  )
136.  (MR-Curve-GetFurthestPointFrom CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
137. )
138. ((And
139.   (= "CIRCLE" etype)
140.   (Equal POINT (Cdr (Assoc 10 elst)) 1e-8)
141.  )
142.  (MR-Curve-GetFurthestPointFrom CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
143. )
144. ((And
145.   (= "ELLIPSE" etype)
146.   (Equal POINT (Cdr (Assoc 10 elst)) 1e-8)
147.  )
148.  (MR-Curve-GetFurthestPointFrom CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
149. )
150. ((And
151.   (= "LWPOLYLINE" etype)
152.   (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst)
153.  )
154.  (Car
155.   (VL-Sort (MapCar (Function Cdr) (VL-Remove-If-Not (Function (Lambda ( x ) (= 10 (Car x)))) elst))
156.            (Function (Lambda ( a b ) (IsFurther a b POINT)) )
157.   )
158.  )
159. )
160. ((And
161.   (= "LWPOLYLINE" etype)
162.   (not (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst))
163.   (member-fuzz POINT (_plcents CURVE) 1e-8)
164.  )
165.  (MR-Curve-GetFurthestPointFrom CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
166. )
167. ((And
168.   (= "POLYLINE" etype)
169.   (SetQ 2dtype (Cdr (Assoc 100 (Reverse elst))))
170.   (SetQ elst (_polyvertices elst))
171.   (not (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst))
172.   (If (= 2dtype "AcDb2dPolyline") (member-fuzz POINT (_plcents CURVE) 1e-8))
173.  )
174.  (MR-Curve-GetFurthestPointFrom CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
175. )
176. ((And
177.   (= "POLYLINE" etype)
178.   (not (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst))
179.  )
180.  (MR-Curve-GetFurthestPointFrom CURVE POINT)
181. )
182. ((And
183.   (= "POLYLINE" etype)
184.   (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst)
185.  )
186.  (Car
187.   (VL-Sort (MapCar (Function Cdr) (VL-Remove-If-Not (Function (Lambda ( x ) (= 10 (Car x)))) elst))
188.            (Function (Lambda ( a b ) (IsFurther a b POINT)) )
189.   )
190.  )
191. )
192. (T
193.  (MR-Curve-GetFurthestPointFrom CURVE POINT)
194. )
195. )
196. )
197.  

And I also made revision for usage without spline objects - little slower, but exact results (too bad you can't draw circle that tang snap spline)... Autodesk should seriously revise spline osnaps - you can't get int snap when self-crossed and you can't use tan snap with circles like in this mine case...

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on August 21, 2012, 10:08:44 AM

And here is my most recent revision with circle subfunction and with normal subfunction combined into single (vlax-curve-getfurthestpointfrom)... Little slower, but till now probably the most exact results - only thing that remains is spline, but here also result is near expected but not exact...

Code - Auto/Visual Lisp: [Select]

1. (Defun MR-Curve-GetFurthestPointFromCircle ( CURVE POINT / samples tolerance IsFurther FurthestParameter elst etype cent rad vec mag pt )
2. (SetQ samples 200
3.      tolerance 1e-14
4. )
5.  
6. (Defun FurthestParameter (SP EP / seg params par furthest f ff )
7. (SetQ params (List SP))
8. (SetQ seg 0.0)
9.  
10. (Defun IsFurther ( A B P )
11.  (>= (Distance A P) (Distance B P))
12. )
13.  
14. (Repeat samples
15.  (SetQ params (Cons (+ SP (SetQ seg (+ seg (/ (- EP SP) samples)))) params))
16. )
17.  
18. (SetQ furthest (Car (SetQ par
19.                 (Vl-Sort-I
20.                  params
21.                  (Function
22.                   (Lambda (a b)
23.                    (IsFurther
24.                     (VLAX-Curve-GetPointAtParam CURVE a)
25.                     (VLAX-Curve-GetPointAtParam CURVE b)
26.                     POINT
27.                    )
28.                   )
29.                  )
30.                 ))
31.                )
32. )
33.  
34. (setq f (nth furthest params))
35.  
36. (If (and (/= f ff) (> (- (VLAX-Curve-GetDistAtParam CURVE EP) (VLAX-Curve-GetDistAtParam CURVE SP)) tolerance))
37.  (setq ff (FurthestParameter
38.   (If (< (Nth furthest params) (Nth (Cadr par) params))
39.    (Nth furthest params)
40.    (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth furthest params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr par) params)) 1e-8))
41.     (Nth (Cadr par) params)
42.     (Nth (Caddr par) params)
43.    )
44.   )
45.   (If (< (Nth furthest params) (Nth (Cadr par) params))
46.    (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth furthest params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr par) params)) 1e-8))
47.     (Nth (Cadr par) params)
48.     (Nth (Caddr par) params)
49.    )
50.    (Nth furthest params)
51.   )
52.  ))
53.  (setq ff (Nth furthest params))
54. )
55.  
56. ff
57. )
58.  
59. (Setq pt
60.  (VLAX-Curve-GetPointAtParam
61.   CURVE
62.   (FurthestParameter
63.    (VLAX-Curve-GetStartParam CURVE)
64.    (VLAX-Curve-GetEndParam CURVE)
65.   )
66.  )
67. )
68. (setq osm (getvar 'osmode))
69. (setvar 'osmode 257)
70. (vl-cmdf "_.CIRCLE" point pt)
71. (setq pt (vlax-invoke (vlax-ename->vla-object curve) 'IntersectWith (vlax-ename->vla-object (entlast)) acExtendNone))
72. (entdel (entlast))
73. (setvar 'osmode osm)
74. pt
75. )
76.  
77. (Defun MR-Curve-GetFurthestPointFrom ( CURVE POINT / samples tolerance IsFurther FurthestParameter elst etype cent rad vec mag)
78. (SetQ samples 200
79.      tolerance 1e-14
80. )
81.  
82. (Defun FurthestParameter (SP EP / seg params par furthest f ff )
83. (SetQ params (List SP))
84. (SetQ seg 0.0)
85.  
86. (Defun IsFurther ( A B P )
87.  (>= (Distance A P) (Distance B P))
88. )
89.  
90. (Repeat samples
91.  (SetQ params (Cons (+ SP (SetQ seg (+ seg (/ (- EP SP) samples)))) params))
92. )
93.  
94. (SetQ furthest (Car (SetQ par
95.                 (Vl-Sort-I
96.                  params
97.                  (Function
98.                   (Lambda (a b)
99.                    (IsFurther
100.                     (VLAX-Curve-GetPointAtParam CURVE a)
101.                     (VLAX-Curve-GetPointAtParam CURVE b)
102.                     POINT
103.                    )
104.                   )
105.                  )
106.                 ))
107.                )
108. )
109.  
110. (setq f (nth furthest params))
111.  
112. (If (and (/= f ff) (> (- (VLAX-Curve-GetDistAtParam CURVE EP) (VLAX-Curve-GetDistAtParam CURVE SP)) tolerance))
113.  (setq ff (FurthestParameter
114.   (If (< (Nth furthest params) (Nth (Cadr par) params))
115.    (Nth furthest params)
116.    (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth furthest params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr par) params)) 1e-8))
117.     (Nth (Cadr par) params)
118.     (Nth (Caddr par) params)
119.    )
120.   )
121.   (If (< (Nth furthest params) (Nth (Cadr par) params))
122.    (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth furthest params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr par) params)) 1e-8))
123.     (Nth (Cadr par) params)
124.     (Nth (Caddr par) params)
125.    )
126.    (Nth furthest params)
127.   )
128.  ))
129.  (setq ff (Nth furthest params))
130. )
131.  
132. ff
133. )
134.  
135.  (VLAX-Curve-GetPointAtParam
136.   CURVE
137.   (FurthestParameter
138.    (VLAX-Curve-GetStartParam CURVE)
139.    (VLAX-Curve-GetEndParam CURVE)
140.   )
141.  )
142.  
143. )
144.  
145. (defun vlax-curve-getfurthestpointfrom ( CURVE POINT / elst etype 2dtype lstn )
146.  
147. (Defun IsFurther ( A B P )
148.  (>= (Distance A P) (Distance B P))
149. )
150.  
151. (defun _polyvertices ( lst )
152.   (_vertices2 (entnext (cdr (assoc -1 lst))))
153. )
154.  
155. (defun _vertices2 ( e )
156.   (if (eq "VERTEX" (cdr (assoc 0 (entget e))))
157.     (progn
158.       (setq lstn (cons (assoc 10 (entget e)) lstn))
159.       (setq lstn (cons (assoc 42 (entget e)) lstn))
160.       (_vertices2 (entnext e))
161.     )
162.   )
163.   (reverse lstn)
164. )
165.  
166. (defun member-fuzz (expr lst fuzz)
167.   (while (and lst (not (equal (car lst) expr fuzz)))
168.     (setq lst (cdr lst))
169.   )
170.   lst
171. )
172.  
173. (defun _plcents ( ent / enpar n p1 p2 bulge rad cen cenlst )
174.   (setq enpar (vlax-curve-getendparam ent))
175.   (setq n -1)
176.   (repeat (fix enpar)
177.     (setq n (1+ n))
178.     (setq p1 (vlax-curve-getpointatparam ent (float n)))
179.     (setq p2 (vlax-curve-getpointatparam ent (float (1+ n))))
180.     (setq bulge (vla-getbulge (vlax-ename->vla-object ent) (float n)))
181.     (if (/= bulge 0.0)
182.       (progn
183.         (setq rad (/ (distance p1 p2) (* 2 (sin (* 2 (atan bulge))))))
184.         (setq cen (polar p1 (+ (angle p1 p2) (- (/ pi 2.0) (* 2 (atan bulge)))) rad))
185.         (setq cenlst (cons cen cenlst))
186.       )
187.     )
188.   )
189.   (reverse cenlst)
190. )
191.  
192. (SetQ elst (entget CURVE))
193. (SetQ etype (Cdr (Assoc 0 elst)))
194.  
195. (Cond
196. ((= "XLINE" etype)
197.  nil
198. )
199. ((= "RAY" etype)
200.  nil
201. )
202. ((= "LINE" etype)
203.  (If (IsFurther (Cdr (Assoc 10 elst)) (Cdr (Assoc 11 elst)) POINT)
204.   (Cdr (Assoc 10 elst))
205.   (Cdr (Assoc 11 elst))
206.  )
207. )
208. ((And
209.   (= "ARC" etype)
210.   (Equal POINT (Cdr (Assoc 10 elst)) 1e-8)
211.  )
212.  (MR-Curve-GetFurthestPointFromCircle CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
213. )
214. ((And
215.   (= "CIRCLE" etype)
216.   (Equal POINT (Cdr (Assoc 10 elst)) 1e-8)
217.  )
218.  (MR-Curve-GetFurthestPointFromCircle CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
219. )
220. ((And
221.   (= "ELLIPSE" etype)
222.   (Equal POINT (Cdr (Assoc 10 elst)) 1e-8)
223.  )
224.  (MR-Curve-GetFurthestPointFromCircle CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
225. )
226. ((And
227.   (= "LWPOLYLINE" etype)
228.   (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst)
229.  )
230.  (Car
231.   (VL-Sort (MapCar (Function Cdr) (VL-Remove-If-Not (Function (Lambda ( x ) (= 10 (Car x)))) elst))
232.            (Function (Lambda ( a b ) (IsFurther a b POINT)) )
233.   )
234.  )
235. )
236. ((And
237.   (= "LWPOLYLINE" etype)
238.   (not (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst))
239.   (member-fuzz POINT (_plcents CURVE) 1e-8)
240.  )
241.  (MR-Curve-GetFurthestPointFromCircle CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
242. )
243. ((And
244.   (= "POLYLINE" etype)
245.   (SetQ 2dtype (Cdr (Assoc 100 (Reverse elst))))
246.   (SetQ elst (_polyvertices elst))
247.   (not (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst))
248.   (If (= 2dtype "AcDb2dPolyline") (member-fuzz POINT (_plcents CURVE) 1e-8))
249.  )
250.  (MR-Curve-GetFurthestPointFromCircle CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
251. )
252. ((And
253.   (= "POLYLINE" etype)
254.   (not (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst))
255.  )
256.  (MR-Curve-GetFurthestPointFromCircle CURVE POINT)
257. )
258. ((And
259.   (= "POLYLINE" etype)
260.   (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst)
261.  )
262.  (Car
263.   (VL-Sort (MapCar (Function Cdr) (VL-Remove-If-Not (Function (Lambda ( x ) (= 10 (Car x)))) elst))
264.            (Function (Lambda ( a b ) (IsFurther a b POINT)) )
265.   )
266.  )
267. )
268. (T
269.  (MR-Curve-GetFurthestPointFrom CURVE POINT)
270. )
271. )
272. )
273.  

Regards, M.R.

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on August 22, 2012, 05:44:33 AM

My final revision, you should get exact result and for splines...

Code - Auto/Visual Lisp: [Select]

1. (Defun MR-Curve-GetFurthestPointFromCircleSpline ( CURVE POINT / samples tolerance IsFurther FurthestParameter elst etype cent rad vec mag pt )
2. (SetQ samples 200
3.      tolerance 1e-8
4. )
5.  
6. (Defun FurthestParameter (SP EP / seg params par furthest f ff ci cidata rad r rr k )
7. (SetQ params (List SP))
8. (SetQ seg 0.0)
9.  
10. (Defun IsFurther ( A B P )
11.  (>= (Distance A P) (Distance B P))
12. )
13.  
14. (Repeat samples
15.  (SetQ params (Cons (+ SP (SetQ seg (+ seg (/ (- EP SP) samples)))) params))
16. )
17.  
18. (SetQ furthest (Car (SetQ par
19.                 (Vl-Sort-I
20.                  params
21.                  (Function
22.                   (Lambda (a b)
23.                    (IsFurther
24.                     (VLAX-Curve-GetPointAtParam CURVE a)
25.                     (VLAX-Curve-GetPointAtParam CURVE b)
26.                     POINT
27.                    )
28.                   )
29.                  )
30.                 ))
31.                )
32. )
33.  
34. (setq f (nth furthest params))
35.  
36. (If (and (/= f ff) (> (- (VLAX-Curve-GetDistAtParam CURVE EP) (VLAX-Curve-GetDistAtParam CURVE SP)) tolerance))
37.  (setq ff (FurthestParameter
38.   (If (< (Nth furthest params) (Nth (Cadr par) params))
39.    (Nth furthest params)
40.    (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth furthest params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr par) params)) 1e-8))
41.     (Nth (Cadr par) params)
42.     (Nth (Caddr par) params)
43.    )
44.   )
45.   (If (< (Nth furthest params) (Nth (Cadr par) params))
46.    (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth furthest params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr par) params)) 1e-8))
47.     (Nth (Cadr par) params)
48.     (Nth (Caddr par) params)
49.    )
50.    (Nth furthest params)
51.   )
52.  ))
53.  (setq ff (Nth furthest params))
54. )
55.  
56. ff
57. )
58.  
59. (Setq pt
60.  (VLAX-Curve-GetPointAtParam
61.   CURVE
62.   (FurthestParameter
63.    (VLAX-Curve-GetStartParam CURVE)
64.    (VLAX-Curve-GetEndParam CURVE)
65.   )
66.  )
67. )
68.  
69. (setq osm (getvar 'osmode))
70. (setvar 'osmode 0)
71. (vl-cmdf "_.CIRCLE" point pt)
72. (setq rad (cdr (assoc 40 (setq cidata (entget (setq ci (entlast)))))))
73. (setq pt (vlax-invoke (vlax-ename->vla-object curve) 'IntersectWith (vlax-ename->vla-object ci) acExtendNone))
74. (setq k 0.0)
75. (while (> (length pt) 3)
76.  (setq r (+ rad (* 1e-8 (setq k (1+ k)))))
77.  (entmod (subst (cons 40 r) (assoc 40 cidata) cidata))
78.  (entupd ci)
79.  (setq pt (vlax-invoke (vlax-ename->vla-object curve) 'IntersectWith (vlax-ename->vla-object ci) acExtendNone))
80. )
81. (setq k 0.0)
82. (setq r (cdr (assoc 40 cidata)))
83. (while (/= (length pt) 3)
84.  (setq rr (- r (* 1e-10 (setq k (1+ k)))))
85.  (entmod (subst (cons 40 rr) (assoc 40 cidata) cidata))
86.  (entupd ci)
87.  (setq pt (vlax-invoke (vlax-ename->vla-object curve) 'IntersectWith (vlax-ename->vla-object ci) acExtendNone))
88. )
89. (entdel ci)
90. (setvar 'osmode osm)
91. pt
92. )
93.  
94. (Defun MR-Curve-GetFurthestPointFromCircle ( CURVE POINT / samples tolerance IsFurther FurthestParameter elst etype cent rad vec mag pt )
95. (SetQ samples 200
96.      tolerance 1e-8
97. )
98.  
99. (Defun FurthestParameter (SP EP / seg params par furthest f ff )
100. (SetQ params (List SP))
101. (SetQ seg 0.0)
102.  
103. (Defun IsFurther ( A B P )
104.  (>= (Distance A P) (Distance B P))
105. )
106.  
107. (Repeat samples
108.  (SetQ params (Cons (+ SP (SetQ seg (+ seg (/ (- EP SP) samples)))) params))
109. )
110.  
111. (SetQ furthest (Car (SetQ par
112.                 (Vl-Sort-I
113.                  params
114.                  (Function
115.                   (Lambda (a b)
116.                    (IsFurther
117.                     (VLAX-Curve-GetPointAtParam CURVE a)
118.                     (VLAX-Curve-GetPointAtParam CURVE b)
119.                     POINT
120.                    )
121.                   )
122.                  )
123.                 ))
124.                )
125. )
126.  
127. (setq f (nth furthest params))
128.  
129. (If (and (/= f ff) (> (- (VLAX-Curve-GetDistAtParam CURVE EP) (VLAX-Curve-GetDistAtParam CURVE SP)) tolerance))
130.  (setq ff (FurthestParameter
131.   (If (< (Nth furthest params) (Nth (Cadr par) params))
132.    (Nth furthest params)
133.    (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth furthest params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr par) params)) 1e-8))
134.     (Nth (Cadr par) params)
135.     (Nth (Caddr par) params)
136.    )
137.   )
138.   (If (< (Nth furthest params) (Nth (Cadr par) params))
139.    (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth furthest params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr par) params)) 1e-8))
140.     (Nth (Cadr par) params)
141.     (Nth (Caddr par) params)
142.    )
143.    (Nth furthest params)
144.   )
145.  ))
146.  (setq ff (Nth furthest params))
147. )
148.  
149. ff
150. )
151.  
152. (Setq pt
153.  (VLAX-Curve-GetPointAtParam
154.   CURVE
155.   (FurthestParameter
156.    (VLAX-Curve-GetStartParam CURVE)
157.    (VLAX-Curve-GetEndParam CURVE)
158.   )
159.  )
160. )
161. (setq osm (getvar 'osmode))
162. (setvar 'osmode 257)
163. (vl-cmdf "_.CIRCLE" point pt)
164. (setq pt (vlax-invoke (vlax-ename->vla-object curve) 'IntersectWith (vlax-ename->vla-object (entlast)) acExtendNone))
165. (entdel (entlast))
166. (setvar 'osmode osm)
167. pt
168. )
169.  
170. (defun vlax-curve-getfurthestpointfrom ( CURVE POINT / elst etype 2dtype lstn )
171.  
172. (Defun IsFurther ( A B P )
173.  (>= (Distance A P) (Distance B P))
174. )
175.  
176. (defun _polyvertices ( lst )
177.   (_vertices2 (entnext (cdr (assoc -1 lst))))
178. )
179.  
180. (defun _vertices2 ( e )
181.   (if (eq "VERTEX" (cdr (assoc 0 (entget e))))
182.     (progn
183.       (setq lstn (cons (assoc 10 (entget e)) lstn))
184.       (setq lstn (cons (assoc 42 (entget e)) lstn))
185.       (_vertices2 (entnext e))
186.     )
187.   )
188.   (reverse lstn)
189. )
190.  
191. (defun member-fuzz (expr lst fuzz)
192.   (while (and lst (not (equal (car lst) expr fuzz)))
193.     (setq lst (cdr lst))
194.   )
195.   lst
196. )
197.  
198. (defun _plcents ( ent / enpar n p1 p2 bulge rad cen cenlst )
199.   (setq enpar (vlax-curve-getendparam ent))
200.   (setq n -1)
201.   (repeat (fix enpar)
202.     (setq n (1+ n))
203.     (setq p1 (vlax-curve-getpointatparam ent (float n)))
204.     (setq p2 (vlax-curve-getpointatparam ent (float (1+ n))))
205.     (setq bulge (vla-getbulge (vlax-ename->vla-object ent) (float n)))
206.     (if (/= bulge 0.0)
207.       (progn
208.         (setq rad (/ (distance p1 p2) (* 2 (sin (* 2 (atan bulge))))))
209.         (setq cen (polar p1 (+ (angle p1 p2) (- (/ pi 2.0) (* 2 (atan bulge)))) rad))
210.         (setq cenlst (cons cen cenlst))
211.       )
212.     )
213.   )
214.   (reverse cenlst)
215. )
216.  
217. (SetQ elst (entget CURVE))
218. (SetQ etype (Cdr (Assoc 0 elst)))
219.  
220. (Cond
221. ((= "XLINE" etype)
222.  nil
223. )
224. ((= "RAY" etype)
225.  nil
226. )
227. ((= "LINE" etype)
228.  (If (IsFurther (Cdr (Assoc 10 elst)) (Cdr (Assoc 11 elst)) POINT)
229.   (Cdr (Assoc 10 elst))
230.   (Cdr (Assoc 11 elst))
231.  )
232. )
233. ((And
234.   (= "ARC" etype)
235.   (Equal POINT (Cdr (Assoc 10 elst)) 1e-8)
236.  )
237.  (MR-Curve-GetFurthestPointFromCircle CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
238. )
239. ((And
240.   (= "CIRCLE" etype)
241.   (Equal POINT (Cdr (Assoc 10 elst)) 1e-8)
242.  )
243.  (MR-Curve-GetFurthestPointFromCircle CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
244. )
245. ((And
246.   (= "ELLIPSE" etype)
247.   (Equal POINT (Cdr (Assoc 10 elst)) 1e-8)
248.  )
249.  (MR-Curve-GetFurthestPointFromCircle CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
250. )
251. ((And
252.   (= "LWPOLYLINE" etype)
253.   (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst)
254.  )
255.  (Car
256.   (VL-Sort (MapCar (Function Cdr) (VL-Remove-If-Not (Function (Lambda ( x ) (= 10 (Car x)))) elst))
257.            (Function (Lambda ( a b ) (IsFurther a b POINT)) )
258.   )
259.  )
260. )
261. ((And
262.   (= "LWPOLYLINE" etype)
263.   (not (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst))
264.   (member-fuzz POINT (_plcents CURVE) 1e-8)
265.  )
266.  (MR-Curve-GetFurthestPointFromCircle CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
267. )
268. ((And
269.   (= "POLYLINE" etype)
270.   (SetQ 2dtype (Cdr (Assoc 100 (Reverse elst))))
271.   (SetQ elst (_polyvertices elst))
272.   (not (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst))
273.   (If (= 2dtype "AcDb2dPolyline") (member-fuzz POINT (_plcents CURVE) 1e-8))
274.  )
275.  (MR-Curve-GetFurthestPointFromCircle CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
276. )
277. ((And
278.   (= "POLYLINE" etype)
279.   (not (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst))
280.  )
281.  (MR-Curve-GetFurthestPointFromCircle CURVE POINT)
282. )
283. ((And
284.   (= "POLYLINE" etype)
285.   (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst)
286.  )
287.  (Car
288.   (VL-Sort (MapCar (Function Cdr) (VL-Remove-If-Not (Function (Lambda ( x ) (= 10 (Car x)))) elst))
289.            (Function (Lambda ( a b ) (IsFurther a b POINT)) )
290.   )
291.  )
292. )
293. (T
294.  (MR-Curve-GetFurthestPointFromCircleSpline CURVE POINT)
295. )
296. )
297. )
298.  

Regards, M.R.
 8-)

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on August 22, 2012, 07:11:11 AM

Important note :

- For 3d curve and point you should use :
http://www.theswamp.org/index.php?topic=42246.msg477514#msg477514
vlax-curve-getfurthestpointfrom-MR-rev.lsp
and result may have imperfections...

- For 2d curve and point that lie in WCS you should use :
http://www.theswamp.org/index.php?topic=42246.msg477659#msg477659
vlax-curve-getfurthestpointfrom-MR-revision-new.lsp
and result should be exactly correct...

Regards, M.R.

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on August 22, 2012, 01:53:56 PM

Although it not too much wise, combined into single function (vlax-curve-getfurthestpointfrom) for 2d geometry + 3d geometry.

M.R.

[EDIT: some minor modifications - till now there was 14 downloads - replaced *.lsp]

Title: Re: vlax-curve-getfurthestpointfrom
Post by: chlh_jd on August 22, 2012, 04:44:24 PM

Quote from: ribarm on August 21, 2012, 08:42:04 AM

Quote from: chlh_jd on July 24, 2012, 02:33:06 AM

For Circle , this way ?

Code: [Select]

((= "CIRCLE" etype)
  ((lambda (p c r)
     (polar p (angle p c) (* 2. r))
   )
    (vlax-curve-getclosestpointto curve point)
    (cdr (Assoc 10 elst))
    (cdr (assoc 40 elst))
  )
)


Yes, chlh_jd, that would sure solve the case, but I wonder how no one didn't saw that in my code - Zoltan's also is written (repeat (1- samples) ...), and should be (repeat samples ...)... So here is my slightly modifications :

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 .

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on August 23, 2012, 07:12:54 AM

Quote from: chlh_jd on August 22, 2012, 04:44:24 PM

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)...

BTW. I changed my last attached *.lsp with some minor modifications (checked point may not be in plane, but if curve is, it finds furthest point from projected check point onto WCS using (vlax-curve-getfurthestpointfrom2d) subfunction... Also turned off echoing of (vl-cmdf "_.CIRCLE" point pt) while computing inside subfunctions...

Quote

And finally make sure checked point is transformed into WCS coordinates before calculations begin (trans point 1 0) - so you may start function no matter what UCS is currently active...

[EDIT : I've checked (vlax-curve-getclosestpointto) for some random UCS, and it assumed that checked point is in WCS and returned point in WCS, so I returned back my function to work the same way...]

M.R.

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on August 23, 2012, 11:57:15 AM

I've decided to post *.lsp in code view since it was modified several times... Sorry for this, but this modifications are unavoidable...

Code: [Select]

(Defun MR-Curve-GetFurthestPointFromCircle ( CURVE POINT / osm cmde samples tolerance IsFurther FurthestParameter elst etype cent rad vec mag pt )
(SetQ samples 200
     tolerance 1e-8
)
 
(Defun FurthestParameter (SP EP / seg params par furthest f ff ci cidata rad r rr k )
(SetQ params (List SP))
(SetQ seg 0.0)

(Defun IsFurther ( A B P )
 (>= (Distance A P) (Distance B P))
)
 
(Repeat samples
 (SetQ params (Cons (+ SP (SetQ seg (+ seg (/ (- EP SP) samples)))) params))
)
 
(SetQ furthest (Car (SetQ par
                (Vl-Sort-I
                 params
                 (Function
                  (Lambda (a b)
                   (IsFurther
                    (VLAX-Curve-GetPointAtParam CURVE a)
                    (VLAX-Curve-GetPointAtParam CURVE b)
                    POINT
                   )
                  )
                 )
                ))
               )
)

(setq f (nth furthest params))

(If (and (/= f ff) (> (- (VLAX-Curve-GetDistAtParam CURVE EP) (VLAX-Curve-GetDistAtParam CURVE SP)) tolerance))
 (setq ff (FurthestParameter
  (If (< (Nth furthest params) (Nth (Cadr par) params))
   (Nth furthest params)
   (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth furthest params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr par) params)) 1e-8))
    (Nth (Cadr par) params)
    (Nth (Caddr par) params)
   )
  )
  (If (< (Nth furthest params) (Nth (Cadr par) params))
   (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth furthest params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr par) params)) 1e-8))
    (Nth (Cadr par) params)
    (Nth (Caddr par) params)
   )
   (Nth furthest params)
  )
 ))
 (setq ff (Nth furthest params))
)

ff
)

(Setq pt
 (VLAX-Curve-GetPointAtParam
  CURVE
  (FurthestParameter
   (VLAX-Curve-GetStartParam CURVE)
   (VLAX-Curve-GetEndParam CURVE)
  )
 )
)

(setq cmde (getvar 'cmdecho))
(setq osm (getvar 'osmode))
(setvar 'cmdecho 0)
(setvar 'osmode 0)
(vl-cmdf "_.CIRCLE" (trans point 0 1) (trans pt 0 1))
(setq rad (cdr (assoc 40 (setq cidata (entget (setq ci (entlast)))))))
(setq pt (vlax-invoke (vlax-ename->vla-object curve) 'IntersectWith (vlax-ename->vla-object ci) acExtendNone))
(setq k 0.0)
(while (> (length pt) 3)
 (setq r (+ rad (* 1e-4 (setq k (1+ k)))))
 (entmod (subst (cons 40 r) (assoc 40 cidata) cidata))
 (entupd ci)
 (setq pt (vlax-invoke (vlax-ename->vla-object curve) 'IntersectWith (vlax-ename->vla-object ci) acExtendNone))
)
(setq k 0.0)
(setq r (cdr (assoc 40 cidata)))
(while (/= (length pt) 3)
 (setq rr (- r (* 1e-8 (setq k (1+ k)))))
 (entmod (subst (cons 40 rr) (assoc 40 cidata) cidata))
 (entupd ci)
 (setq pt (vlax-invoke (vlax-ename->vla-object curve) 'IntersectWith (vlax-ename->vla-object ci) acExtendNone))
)
(entdel ci)
(setvar 'osmode osm)
(setvar 'cmdecho cmde)
(list (car pt) (cadr pt) (caddr pt))
)

(defun vlax-curve-getfurthestpointfrom2d ( CURVE POINT / elst etype 2dtype lstn )

(Defun IsFurther ( A B P )
 (>= (Distance A P) (Distance B P))
)
 
(defun _polyvertices ( lst )
  (_vertices2 (entnext (cdr (assoc -1 lst))))
)
 
(defun _vertices2 ( e )
  (if (eq "VERTEX" (cdr (assoc 0 (entget e))))
    (progn
      (setq lstn (cons (assoc 10 (entget e)) lstn))
      (setq lstn (cons (assoc 42 (entget e)) lstn))
      (_vertices2 (entnext e))
    )
  )
  (reverse lstn)
)
 
(defun member-fuzz (expr lst fuzz)
  (while (and lst (not (equal (car lst) expr fuzz)))
    (setq lst (cdr lst))
  )
  lst
)
 
(defun _plcents ( ent / enpar n p1 p2 bulge rad cen cenlst )
  (setq enpar (vlax-curve-getendparam ent))
  (setq n -1)
  (repeat (fix enpar)
    (setq n (1+ n))
    (setq p1 (vlax-curve-getpointatparam ent (float n)))
    (setq p2 (vlax-curve-getpointatparam ent (float (1+ n))))
    (setq bulge (vla-getbulge (if (eq (type ent) 'ENAME) (vlax-ename->vla-object ent) ent) (float n)))
    (if (/= bulge 0.0)
      (progn
        (setq rad (/ (distance p1 p2) (* 2 (sin (* 2 (atan bulge))))))
        (setq cen (polar p1 (+ (angle p1 p2) (- (/ pi 2.0) (* 2 (atan bulge)))) rad))
        (setq cenlst (cons cen cenlst))
      )
    )
  )
  (reverse cenlst)
)
 
(SetQ elst (entget CURVE))
(SetQ etype (Cdr (Assoc 0 elst)))

(Cond
((And
  (= "ARC" etype)
  (Equal POINT (Cdr (Assoc 10 elst)) 1e-8)
 )
 (MR-Curve-GetFurthestPointFromCircle CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
)
((And
  (= "CIRCLE" etype)
  (Equal POINT (Cdr (Assoc 10 elst)) 1e-8)
 )
 (MR-Curve-GetFurthestPointFromCircle CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
)
((And
  (= "ELLIPSE" etype)
  (Equal POINT (Cdr (Assoc 10 elst)) 1e-8)
 )
 (MR-Curve-GetFurthestPointFromCircle CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
)
((And
  (= "LWPOLYLINE" etype)
  (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst)
 )
 (Car
  (VL-Sort (MapCar (Function Cdr) (VL-Remove-If-Not (Function (Lambda ( x ) (= 10 (Car x)))) elst))
           (Function (Lambda ( a b ) (IsFurther a b POINT)) )
  )
 )
)
((And
  (= "LWPOLYLINE" etype)
  (not (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst))
  (member-fuzz POINT (_plcents (if vla-curve vla-CURVE CURVE)) 1e-8)
 )
 (MR-Curve-GetFurthestPointFromCircle CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
)
((And
  (= "LWPOLYLINE" etype)
  (not (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst))
  (not (member-fuzz POINT (_plcents (if vla-curve vla-CURVE CURVE)) 1e-8))
 )
 (MR-Curve-GetFurthestPointFromCircle CURVE POINT)
)
((And
  (= "POLYLINE" etype)
  (SetQ 2dtype (Cdr (Assoc 100 (Reverse elst))))
  (SetQ elst (_polyvertices elst))
  (not (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst))
  (and (= 2dtype "AcDb2dPolyline") (member-fuzz POINT (_plcents (if vla-curve vla-CURVE CURVE)) 1e-8))
 )
 (MR-Curve-GetFurthestPointFromCircle CURVE (Mapcar '+ POINT (List -1e-3 -1e-3 0.0)))
)
((And
  (= "POLYLINE" etype)
  (not (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst))
  (not (member-fuzz POINT (_plcents (if vla-curve vla-CURVE CURVE)) 1e-8))
 )
 (MR-Curve-GetFurthestPointFromCircle CURVE POINT)
)
((And
  (= "POLYLINE" etype)
  (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst)
 )
 (Car
  (VL-Sort (MapCar (Function Cdr) (VL-Remove-If-Not (Function (Lambda ( x ) (= 10 (Car x)))) elst))
           (Function (Lambda ( a b ) (IsFurther a b POINT)) )
  )
 )
)
(T
 (MR-Curve-GetFurthestPointFromCircle CURVE POINT)
)
)
)

(Defun MR-Curve-GetFurthestPointFrom ( CURVE POINT / samples tolerance IsFurther FurthestParameter elst etype cent rad vec mag )
(SetQ samples 200
     tolerance 1e-14
)
 
(Defun FurthestParameter (SP EP / seg params par furthest f ff )
(SetQ params (List SP))
(SetQ seg 0.0)

(Defun IsFurther ( A B P )
 (>= (Distance A P) (Distance B P))
)
 
(Repeat samples
 (SetQ params (Cons (+ SP (SetQ seg (+ seg (/ (- EP SP) samples)))) params))
)
 
(SetQ furthest (Car (SetQ par
                (Vl-Sort-I
                 params
                 (Function
                  (Lambda (a b)
                   (IsFurther
                    (VLAX-Curve-GetPointAtParam CURVE a)
                    (VLAX-Curve-GetPointAtParam CURVE b)
                    POINT
                   )
                  )
                 )
                ))
               )
)

(setq f (nth furthest params))

(If (and (/= f ff) (> (- (VLAX-Curve-GetDistAtParam CURVE EP) (VLAX-Curve-GetDistAtParam CURVE SP)) tolerance))
 (setq ff (FurthestParameter
  (If (< (Nth furthest params) (Nth (Cadr par) params))
   (Nth furthest params)
   (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth furthest params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr par) params)) 1e-8))
    (Nth (Cadr par) params)
    (Nth (Caddr par) params)
   )
  )
  (If (< (Nth furthest params) (Nth (Cadr par) params))
   (If (not (equal (VLAX-Curve-GetPointAtParam CURVE (Nth furthest params)) (VLAX-Curve-GetPointAtParam CURVE (Nth (Cadr par) params)) 1e-8))
    (Nth (Cadr par) params)
    (Nth (Caddr par) params)
   )
   (Nth furthest params)
  )
 ))
 (setq ff (Nth furthest params))
)

ff
)
 
 (VLAX-Curve-GetPointAtParam
  CURVE
  (FurthestParameter
   (VLAX-Curve-GetStartParam CURVE)
   (VLAX-Curve-GetEndParam CURVE)
  )
 )
 
)
 
(defun vlax-curve-getfurthestpointfrom3d ( CURVE POINT / elst etype 2dtype lstn )

(Defun IsFurther ( A B P )
 (>= (Distance A P) (Distance B P))
)
 
(defun _polyvertices ( lst )
  (_vertices2 (entnext (cdr (assoc -1 lst))))
)
 
(defun _vertices2 ( e )
  (if (eq "VERTEX" (cdr (assoc 0 (entget e))))
    (progn
      (setq lstn (cons (assoc 10 (entget e)) lstn))
      (setq lstn (cons (assoc 42 (entget e)) lstn))
      (_vertices2 (entnext e))
    )
  )
  (reverse lstn)
)
 
(defun member-fuzz (expr lst fuzz)
  (while (and lst (not (equal (car lst) expr fuzz)))
    (setq lst (cdr lst))
  )
  lst
)
 
(defun _plcents ( ent / enpar n p1 p2 bulge rad cen cenlst )
  (setq enpar (vlax-curve-getendparam ent))
  (setq n -1)
  (repeat (fix enpar)
    (setq n (1+ n))
    (setq p1 (vlax-curve-getpointatparam ent (float n)))
    (setq p2 (vlax-curve-getpointatparam ent (float (1+ n))))
    (setq bulge (vla-getbulge (vlax-ename->vla-object ent) (float n)))
    (if (/= bulge 0.0)
      (progn
        (setq rad (/ (distance p1 p2) (* 2 (sin (* 2 (atan bulge))))))
        (setq cen (polar p1 (+ (angle p1 p2) (- (/ pi 2.0) (* 2 (atan bulge)))) rad))
        (setq cenlst (cons cen cenlst))
      )
    )
  )
  (reverse cenlst)
)
 
(SetQ elst (entget CURVE))
(SetQ etype (Cdr (Assoc 0 elst)))

(Cond
((= "XLINE" etype)
 nil
)
((= "RAY" etype)
 nil
)
((= "LINE" etype)
 (If (IsFurther (Cdr (Assoc 10 elst)) (Cdr (Assoc 11 elst)) POINT)
  (Cdr (Assoc 10 elst))
  (Cdr (Assoc 11 elst))
 )
)
((And
  (= "POLYLINE" etype)
  (VL-Every (Function (Lambda ( x ) (Or (/= 42 (Car x)) (ZeroP (Cdr x))))) elst)
 )
 (Car
  (VL-Sort (MapCar (Function Cdr) (VL-Remove-If-Not (Function (Lambda ( x ) (= 10 (Car x)))) elst))
           (Function (Lambda ( a b ) (IsFurther a b POINT)) )
  )
 )
)
(T
 (MR-Curve-GetFurthestPointFrom CURVE POINT)
)
)
)

;; Vector Cross Product - Lee Mac
;; Args: u,v - vectors in R^3

(defun v^v ( u v )
  (list
    (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
    (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
    (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
  )
)

;; Collinear-p  -  Lee Mac
;; Returns T if p1,p2,p3 are collinear

(defun LM:Collinear-p ( p1 p2 p3 )
    (
        (lambda ( a b c )
            (or
                (equal (+ a b) c 1e-8)
                (equal (+ b c) a 1e-8)
                (equal (+ c a) b 1e-8)
            )
        )
        (distance p1 p2) (distance p2 p3) (distance p1 p3)
    )
)

;; Project Point onto Plane  -  Lee Mac
;; Projects pt onto the plane defined by its origin and normal

(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)
)

(defun vlax-curve-getfurthestpointfrom ( curve point / vla-curve flagarc flaglw cmde pt pt1 pt2 pt3 pt4 )
  (setq cmde (getvar 'cmdecho))
  (if (eq (type curve) 'VLA-OBJECT)
    (progn
      (setq vla-curve curve)
      (setq curve (vlax-vla-object->ename vla-curve))
    )
  )
  (if (eq (cdr (assoc 0 (entget curve))) "ARC")
    (progn
      (setq flagarc T)
      (setvar 'cmdecho 0)
      (vl-cmdf "_.COPY" curve "" '(0.0 0.0 0.0) '(0.0 0.0 0.0))
      (vl-cmdf "_.PEDIT" (entlast) "" "")
      (setq curve (entlast))
      (setvar 'cmdecho cmde)
    )
  )
  (if (eq (cdr (assoc 0 (entget curve))) "LWPOLYLINE")
    (progn
      (setq flaglw T)
      (setvar 'cmdecho 0)
      (vl-cmdf "_.CONVERTPOLY" "H" curve "")
      (setq vla-curve (vlax-ename->vla-object curve))
      (setvar 'cmdecho cmde)
    )
  )
  (setq pt1 (vlax-curve-getpointatparam curve (+ (if (not (vl-catch-all-apply 'vlax-curve-getstartparam (list curve))) 0.0 (vlax-curve-getstartparam curve)) (* 1.0 (/ (- (if (not (vl-catch-all-apply 'vlax-curve-getendparam (list curve))) 3.0 (vlax-curve-getendparam curve)) (if (not (vl-catch-all-apply 'vlax-curve-getstartparam (list curve))) 0.0 (vlax-curve-getstartparam curve))) 3.0)))))
  (setq pt2 (vlax-curve-getpointatparam curve (+ (if (not (vl-catch-all-apply 'vlax-curve-getstartparam (list curve))) 0.0 (vlax-curve-getstartparam curve)) (* 2.0 (/ (- (if (not (vl-catch-all-apply 'vlax-curve-getendparam (list curve))) 3.0 (vlax-curve-getendparam curve)) (if (not (vl-catch-all-apply 'vlax-curve-getstartparam (list curve))) 0.0 (vlax-curve-getstartparam curve))) 3.0)))))
  (setq pt3 (vlax-curve-getpointatparam curve (+ (if (not (vl-catch-all-apply 'vlax-curve-getstartparam (list curve))) 0.0 (vlax-curve-getstartparam curve)) (* 3.0 (/ (- (if (not (vl-catch-all-apply 'vlax-curve-getendparam (list curve))) 3.0 (vlax-curve-getendparam curve)) (if (not (vl-catch-all-apply 'vlax-curve-getstartparam (list curve))) 0.0 (vlax-curve-getstartparam curve))) 3.0)))))
  (setq pt4 (vlax-curve-getstartpoint curve))
  (if (and (not (LM:Collinear-p pt1 pt2 pt3)) (not (LM:Collinear-p pt1 pt2 pt4)) (vlax-curve-isplanar curve))
    (cond ((not (and (equal (caddr pt1) 0.0 1e-8) (equal (caddr pt2) 0.0 1e-8) (equal (caddr pt3) 0.0 1e-8) (equal (caddr pt4) 0.0 1e-8)))
      (progn
        (setvar 'cmdecho 0)
        (vl-cmdf "_.UCS" "w")
        (vl-cmdf "_.UCS" "za" "" (v^v (mapcar '- pt2 pt1) (mapcar '- pt3 pt1)))
        (vl-cmdf "_.UCS" "m" (trans pt1 0 1))
        (setq pt (vlax-curve-getfurthestpointfrom2d curve (LM:ProjectPointToPlane point (trans '(0.0 0.0 0.0) 1 0) (mapcar '- (trans '(0.0 0.0 1.0) 1 0) (trans '(0.0 0.0 0.0) 1 0)))))
        (vl-cmdf "_.UCS" "p")
        (vl-cmdf "_.UCS" "p")
        (vl-cmdf "_.UCS" "p")
        (setvar 'cmdecho cmde)
      ))
      ((and (equal (caddr pt1) 0.0 1e-8) (equal (caddr pt2) 0.0 1e-8) (equal (caddr pt3) 0.0 1e-8) (equal (caddr pt4) 0.0 1e-8) (eq (getvar 'worlducs) 0))
      (progn
        (setvar 'cmdecho 0)
        (vl-cmdf "_.UCS" "w")
        (setq pt (vlax-curve-getfurthestpointfrom2d curve (LM:ProjectPointToPlane point '(0.0 0.0 0.0) '(0.0 0.0 1.0))))
        (vl-cmdf "_.UCS" "p")
        (setvar 'cmdecho cmde)
      ))
      ((and (equal (caddr pt1) 0.0 1e-8) (equal (caddr pt2) 0.0 1e-8) (equal (caddr pt3) 0.0 1e-8) (equal (caddr pt4) 0.0 1e-8) (eq (getvar 'worlducs) 1))
      (setq pt (vlax-curve-getfurthestpointfrom2d curve (LM:ProjectPointToPlane point '(0.0 0.0 0.0) '(0.0 0.0 1.0))))
      )
    )
    (setq pt (vlax-curve-getfurthestpointfrom3d curve point))
  )
  (setvar 'cmdecho 0)
  (gc)
  (if flaglw (vl-cmdf "_.CONVERTPOLY" "L" curve ""))
  (if flagarc (vl-cmdf "_.ERASE" (entlast) ""))
  (setvar 'cmdecho cmde)
  pt
)

M.R.

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on August 24, 2012, 05:14:31 AM

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.

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on August 24, 2012, 06:37:52 AM

Quote from: ribarm on August 24, 2012, 05:14:31 AM

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.

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on August 25, 2012, 04:17:56 AM

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.
 8-) :-)

Title: Re: vlax-curve-getfurthestpointfrom
Post by: chlh_jd on August 28, 2012, 07:59:15 AM

Quote from: ribarm on August 23, 2012, 07:12:54 AM

Quote from: chlh_jd on August 22, 2012, 04:44:24 PM

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))   
    )   
  )


Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on August 28, 2012, 10:32:40 AM

Quote from: chlh_jd on August 28, 2012, 07:59:15 AM

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.

Title: Re: vlax-curve-getfurthestpointfrom
Post by: chlh_jd on September 01, 2012, 02:11:46 AM

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

Title: Re: vlax-curve-getfurthestpointfrom
Post by: DEVITG on September 01, 2012, 04:52:00 PM

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

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on September 03, 2012, 02:28:36 AM

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.

Title: Re: vlax-curve-getfurthestpointfrom
Post by: chlh_jd on September 03, 2012, 04:35:15 AM

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  :-D
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  .

Title: Re: vlax-curve-getfurthestpointfrom
Post by: chlh_jd on September 04, 2012, 07:22:32 AM

Quote from: chlh_jd on September 03, 2012, 04:35:15 AM

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  :-D
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
  )
)


Title: Re: vlax-curve-getfurthestpointfrom
Post by: chlh_jd on September 04, 2012, 07:50:13 AM

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

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on September 04, 2012, 08:21:14 AM

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)...

Title: Re: vlax-curve-getfurthestpointfrom
Post by: chlh_jd on September 13, 2012, 08:16:38 AM

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)))
    ))


Title: Re: vlax-curve-getfurthestpointfrom
Post by: chlh_jd on September 13, 2012, 08:59:57 AM

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

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm on July 27, 2013, 04:09:26 AM

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.

Title: Re: vlax-curve-getfurthestpointfrom
Post by: ribarm 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 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.   (setq ptt (mapcar '+ pt (mapcar '* '(2.0 2.0 2.0) (mapcar '- p pt))))
48.   (setq pp (vlax-curve-getclosestpointto curve ptt))
49.   (while (not (equal p pp 1e-50))
50.     (setq p pp)
51.     (setq ptt (mapcar '+ pt (mapcar '* '(2.0 2.0 2.0) (mapcar '- p pt))))
52.     (setq pp (vlax-curve-getclosestpointto curve ptt))
53.   )
54.   p
55. )
56.  

M.R.
 8-) 8-) 8-)