« previous next »
Pages: 1 [2] 3 4 5 |   Go Down

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

0 Members and 1 Guest are viewing this topic.

zoltan

  • Guest
Re: vlax-curve-getfurthestpointfrom
« Reply #15 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
 
Logged

ribarm

  • Gator
  • Posts: 3265
  • Marko Ribar, architect
Re: vlax-curve-getfurthestpointfrom
« Reply #16 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.
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

BlackBox

  • King Gator
  • Posts: 3770
Re: vlax-curve-getfurthestpointfrom
« Reply #17 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.  ;-)

Logged
"How we think determines what we do, and what we do determines what we get."

PKENEWELL

  • Bull Frog
  • Posts: 317
Re: vlax-curve-getfurthestpointfrom
« Reply #18 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
Logged
"When you are asked if you can do a job, tell 'em, 'Certainly I can!' Then get busy and find out how to do it." - Theodore Roosevelt

ribarm

  • Gator
  • Posts: 3265
  • Marko Ribar, architect
Re: vlax-curve-getfurthestpointfrom
« Reply #19 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)
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

BlackBox

  • King Gator
  • Posts: 3770
Re: vlax-curve-getfurthestpointfrom
« Reply #20 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:

« Last Edit: July 13, 2012, 11:25:14 AM by RenderMan »
Logged
"How we think determines what we do, and what we do determines what we get."

PKENEWELL

  • Bull Frog
  • Posts: 317
Re: vlax-curve-getfurthestpointfrom
« Reply #21 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.
Logged
"When you are asked if you can do a job, tell 'em, 'Certainly I can!' Then get busy and find out how to do it." - Theodore Roosevelt

ronjonp

  • Needs a day job
  • Posts: 7527
Re: vlax-curve-getfurthestpointfrom
« Reply #22 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-)
Logged

Windows 11 x64 - AutoCAD /C3D 2023
Custom Build PC

zoltan

  • Guest
Re: vlax-curve-getfurthestpointfrom
« Reply #23 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.
Logged

ribarm

  • Gator
  • Posts: 3265
  • Marko Ribar, architect
Re: vlax-curve-getfurthestpointfrom
« Reply #24 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.
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

zoltan

  • Guest
Re: vlax-curve-getfurthestpointfrom
« Reply #25 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.
Logged

BlackBox

  • King Gator
  • Posts: 3770
Re: vlax-curve-getfurthestpointfrom
« Reply #26 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 value?

Also worthy of consideration, is mitigating the potential to overload the Stack (perhaps GC will help?).   :?

Otherwise, we'd need to use Linq + Lambda in .NET (to minimize the iterations to calculate result), no? Example (Sorry, you'll have to read through, don't have time to find exact post).
« Last Edit: July 13, 2012, 03:11:57 PM by RenderMan »
Logged
"How we think determines what we do, and what we do determines what we get."

ribarm

  • Gator
  • Posts: 3265
  • Marko Ribar, architect
Re: vlax-curve-getfurthestpointfrom
« Reply #27 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:
« Last Edit: July 13, 2012, 04:41:20 PM by ribarm »
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3265
  • Marko Ribar, architect
Re: vlax-curve-getfurthestpointfrom
« Reply #28 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.
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

zoltan

  • Guest
Re: vlax-curve-getfurthestpointfrom
« Reply #29 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
  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.
Logged
Pages: 1 [2] 3 4 5 |   Go Up
« previous next »