### Author Topic: Point Containment Test: Convex and Concave Polygons  (Read 15415 times)

0 Members and 1 Guest are viewing this topic.

#### zoltan

• Newt
• Posts: 188 ##### Point Containment Test: Convex and Concave Polygons
« on: November 23, 2005, 07:43:25 PM »
Taken right out of "Computer Graphics Handbook, Geometry and Mathematics" by Michael E. Mortenson:

Given a test point Pt determine if it is inside, outside, or on the boundary of a polygon (convex or concave). Do this in two steps:
1. Using the polygon vertex points, find the min-max box.
i. If Pt is not inside the min-max box, then it is not inside the polygon.
ii. If Pt is inside, proceed to the next step.

2. Compute the intersection of y=yt with the edges of the polygon. Consider only the edges whose end points straddle yt. Count intersections with a vertex as two.  There are always an even number of intersections.  Pair the x coordinates of the intersections in ascending order; for example, (x1, x2) (x3, x4), and so on. Then:
i. If xt falls inside an interval, for example x1 < xt > x2, then Pt is inside the polygon.
ii. If xt is identically equal to on of the interval limits, then Pt is on the boundary.
iii. Otherwise Pt is outside the polygon.

So I did that:
Code: [Select]
`;;Determines if a point is inside a polygon defined by an ordered list of points.;;Return 1 if point is inside the boundary, 2 if it is on the boundary and nil otherwise.;;Only works for 2D points, if 3D points are supplies, the Caddr is ignored and;;it will give unpredictable results...well, it already gives unpredictable results, so nevermind.(Defun PointInsidePolygonP ( PNT lstPOINTS FUZZ / dXmin dXmax pntXs pntXe pntTest lstTest lstPairs cnt ) (Cond  ((< (Car PNT) (SetQ dXmin (Apply (Function Min) (MapCar (Function Car) lstPOINTS))))   nil  )  ((> (Car PNT) (SetQ dXmax (Apply (Function Max) (MapCar (Function Car) lstPOINTS))))   nil  )  ((< (Cadr PNT) (Apply (Function Min) (MapCar (Function Cadr) lstPOINTS)))   nil  )  ((> (Cadr PNT) (Apply (Function Max) (MapCar (Function Cadr) lstPOINTS)))   nil  )  (T   (SetQ pntXs (List dXmin (Cadr PNT))         pntXe (List dXmax (Cadr PNT))         lstPOINTS (Cons (Car lstPOINTS) (Reverse lstPOINTS)) ;add fisrt point to the front of the revered list         cnt 0   )   (Repeat (1- (Length lstPOINTS))    (If (SetQ pntTest (Inters (Nth cnt lstPOINTS) (Nth (1+ cnt) lstPOINTS) pntXs pntXe)) ;segment intersects test line     (SetQ lstTest (Cons pntTest lstTest) ) ;add it once    )    (SetQ cnt (1+ cnt) )   )   (SetQ lstTest (VL-Sort (MapCar (Function Car) lstTest) (Function <)) ) ;sort list of x coords   (Repeat 2 ;strip duplicates from front and back    (If (Equal (Car lstTest) (Cadr lstTest) FUZZ)     (SetQ lstTest (Cdr lstTest) )    )    (SetQ lstTest (Reverse lstTest) )   )      (While lstTest ;make list of pairs    (SetQ lstPairs (Cons (List (Car lstTest) (Cadr lstTest)) lstPairs) )    (SetQ lstTest (Cddr lstTest) )   )   (SetQ lstPairs (Reverse lstPairs) )   (Cond    ((Or (VL-Member-If (Function (Lambda (l) (Equal (Car PNT) l FUZZ))) (MapCar (Function Car) lstPairs))         (VL-Member-If (Function (Lambda (l) (Equal (Car PNT) l FUZZ))) (MapCar (Function Cadr) lstPairs))     )     2    )    ((VL-Member-If (Function (Lambda (l) (And (> (Car PNT) (Car l)) (< (Car PNT) (Cadr l))))) lstPairs)     1    )    (T     nil    )   )  ) ))(Defun GetPolylinePoints ( POLY / entPoly lstReturn ) (SetQ entPoly (EntGet POLY) ) (SetQ lstReturn (List (Cdr (Assoc 10 entPoly))) ) (While (Assoc 10 (SetQ entPoly (Cdr (Member (Assoc 10 entPoly) entPoly))) )  (SetQ lstReturn (Cons (Cdr (Assoc 10 entPoly)) lstReturn) ) ) (Reverse lstReturn ))(Defun C:TestME ( / ePolyLine pntPick ) (SetQ ePolyLine (Car (EntSel "Pick a Polyline")) ) (SetQ pntPick (GetPoint "Pick a Point") ) (PointInsidePolygonP pntPick (GetPolylinePoints ePolyLine) 0.00001 ))`
At first I had tested to see if the line straddles the test line like this:
Code: [Select]
`(And (Or (And (< (Cadr (Nth cnt lstPOINTS)) (Cadr PNT))                      (> (Cadr (Nth (1+ cnt) lstPOINTS)) (Cadr PNT) )                 )                 (And (> (Cadr (Nth cnt lstPOINTS)) (Cadr PNT))                      (< (Cadr (Nth (1+ cnt) lstPOINTS)) (Cadr PNT) )                 )             ) ;segment straddles test line             (SetQ pntTest (Inters (Nth cnt lstPOINTS) (Nth (1+ cnt) lstPOINTS) pntXs pntXe) ) ;segment intersects test line        ))`..but it was throwing out points when the test line intersected a vertex, so I threw it out. Then I had it determine if the test point was on one of the vetices like this:
Code: [Select]
`     (If (Or (Equal pntTest (Nth cnt lstPOINTS) FUZZ)             (Equal pntTest (Nth (1+ cnt) lstPOINTS) FUZZ)         ) ;test point is on a vertex      (SetQ lstTest (Cons pntTest lstTest) ;add it twice            lstTest (Cons pntTest lstTest)      )      (SetQ lstTest (Cons pntTest lstTest) ) ;add it once     )`...but the intersection of the two line segments at the vertex were returning two points already, so I threw that out also.

Now here is the problem: if the test line intersects a vertex of the polygon, it adds two points to lstTest. However, if the vertex is on a boudary between an area that is in and an area that is out, it needs to be only one point.  At first I thaught to strip the pairs that occur at the start and the end of the test line, but that is not nessicarilly valid either.  here are some examples: should be two points should be one point should be two points

Basically, if both line segments are on one side of the test line then it should be two points, otherwise it should be one.  This would probably get ugly it the polygon went horizontal for a while and one segment was colinear with the test line.

..Any ideas?

(also, on a side note: this is my first post, I finally found this place after walking around in the wilderness for months after Cadvault died.  I'm very glad to be here.  this type of forum is very important to me and I appreciate all of you.  I have taken a few days to look around and get familliar with the swamp and I've already  seen some names I recognize.  It's good to be back.

On with the LiSPing!!) ##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #1 on: November 23, 2005, 08:37:23 PM »
Hi zoltan, welcome aboard!
Have you thought about using halfspaces?
using the parametric equation of a line you can determine whether the point is inside/outside/on the boundary dividing the space in 2d
Ax + By + C = 0

>0 = inside
<0 = outside
==0 = on the line
Aftr the bb test, this is a quick way to determine if the point is in, out or on the line at the first edge. This requres the edges are iterated in a clockwise fashion so that 'inside' is always to the correct side of the polyline.

Now, the hard part is working out what A,B and C are Once you know those you can simply plug in the x and y coord's and your done.

I didn't get to study linear algebra untill recently so I'm a bit stuck with that, maybe someone here may be able to help out. Forth is like the Tao: it is a Way, and is realized when followed.
Its fragility is its strength; its simplicity is its direction - Michael Ham

Lao Tzu: To attain knowledge, add things
every day; to obtain wisdom, remove things every day.

#### Kerry ##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #2 on: November 23, 2005, 09:13:43 PM »
This may help ... if the points are ordered counter-clockwise, negative is outside

Code: [Select]
`;;;------------------------------------------------------------------;;;------------------------------------------------------------------;;;;;; (k:whichside < ray-origin > < point-on-ray > < point-to-be-tested >);;; return values:;;; negative = point is to the right side of the ray;;; 0 = point is on the ray;;; otherwise point is on the left side of the ray(defun k:whichside (p1 p2 pt / s)  (setq s (cond ((equal p1 pt 1e-14) 0.0)                (t (sin (- (angle p1 pt) (angle p1 p2))))          )  )  (if (equal s 0.0 1e-14)    0.0    s  )`
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<-- ##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #3 on: November 23, 2005, 09:19:01 PM »
heh, that'll do it too. I'm no lisp'er but I can see what's going on. Nice simple solution Kerry. Forth is like the Tao: it is a Way, and is realized when followed.
Its fragility is its strength; its simplicity is its direction - Michael Ham

Lao Tzu: To attain knowledge, add things
every day; to obtain wisdom, remove things every day.

#### zoltan

• Newt
• Posts: 188 ##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #4 on: November 23, 2005, 09:36:43 PM »
Unfortunatelly this will only work if the polygon is convex.  Look at the image, starting at the point with the greatest Y value and working counter-clockwide, my cursure in the first image is on the RIGHT side of the 5th segment and still inside. ##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #5 on: November 23, 2005, 09:49:30 PM »
Then half spaces is the way to go, if you combine all the halfspaces together cropping each other on the way you will be left with a 'region' of points that are either in, on or outside regardless of shape. example pictures

Have a look here for how to determine the equation (I just had an 'aha' moment once I read it).

It's a similar form for planes also to work out if a point is contained inside a volume/solid -> Ax + By + Cz = D where ABC are the components of the plane normal vector.
Forth is like the Tao: it is a Way, and is realized when followed.
Its fragility is its strength; its simplicity is its direction - Michael Ham

Lao Tzu: To attain knowledge, add things
every day; to obtain wisdom, remove things every day.

#### LE

• Guest ##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #6 on: November 23, 2005, 10:30:43 PM »
Do not want to take the fun.... instead I will provide a defun .... made by John F. Uhden, like two moons ago....

Code: [Select]
`(defun @Inside (PIQ Object / ClosestPoint ClosestParam Sample                             Start End P1 P2 P a1 a2 Defl)  ;;               "LOOK, MA... NO RAYS!"  ;; @Inside.lsp v1.0 (09-15-03) John F. Uhden, Cadlantic.  ;; v2.0 Revised (09-17-03) - See notes below.  ;; Function to determine whether a point is inside the boundary  ;; of a closed curve.  ;; It employs the theorem that the sum of the deflections of a  ;; point inside the curve should equal 360°, and if outside 0°  ;; (both absolute values).  ;; The results with Ellipses were fairly rough, and the results  ;; with a Spline were very rough, thus the fuzz factor of 2.  ;;  ;; Arguments:  ;;   PIQ    - Point to test (2D or 3D point as a list in UCS)  ;;   Object - Curve to test (Ename or VLA-Object)  ;;  ;; Returns:  ;;   T   (if the PIQ is inside the curve)  ;;   nil (if either the arguments are invalid,  ;;       or the PIQ is on or outside the curve)  ;;  ;; NOTES:  ;;   Requires one or another version of the @delta function,  ;;     such as included here.  ;;   It will not work well with self-intersecting (overlapping)  ;;     bulged polyline segments.  ;;   Curves can be CIRCLEs, ELLIPSEs, LWPOLYLINEs, POLYLINES,  ;;     SPLINEs, and maybe even more.  ;;   Thanks already to Doug Broad for finding bugs.  (setq Sample 0.2) ; this is better for bulged polylines.  ;;   Sure, you could decrease the sampling from 0.5 to say 0.1,  ;;     but it will only slow down the process and still not  ;;     guarantee success with overlapping bulged segments.  ;;   DO NOT change the sampling value to anything that is  ;;     greater than 1 or not evenly divisible into 1, as you  ;;     would not be sampling vertices.  ;;   (09-17-03) Found that cusps brought back inside the figure  ;;     yield a total deflection of (* pi 2), so changed evaluation  ;;     to see if deflection was greater than 4, which is  ;;     equivalent to a fuzz factor of 2.28 from (* pi 2).  (vl-load-com)  (or (= (type @delta) 'SUBR)    (defun @delta (a1 a2)      (cond        ((> a1 (+ a2 pi))          (+ a2 pi pi (- a1))        )        ((> a2 (+ a1 pi))          (- a2 a1 pi pi)        )        (1 (- a2 a1))      )    )  )  (and    (cond      ((not Object)        (prompt "  No object provided.")      )      ((= (type Object) 'VLA-Object))      ((= (type Object) 'Ename)        (setq Object (vlax-ename->vla-object Object))      )      (1 (prompt "  Improper object type."))    )    (or      (and        (< 1 (vl-list-length PIQ) 4)        (vl-every 'numberp PIQ)      )      (prompt " Improper point value.")    )    (or      (not        (vl-catch-all-error-p          (setq Start            (vl-catch-all-apply              'vlax-curve-getStartPoint              (list Object)            )          )        )      )      (prompt "  Object is not a curve.")    )    (or      (equal Start (vlax-curve-getendpoint Object) 1e-10)      (prompt "  Curve is not closed.")    )    (setq P (trans PIQ 1 0)) ; PIQ in WCS    (setq ClosestPoint      (vlax-curve-getclosestpointto Object P) ; In WCS    )    (not (equal P ClosestPoint 1e-10)) ; in WCS    (setq ClosestParam (vlax-curve-getparamatpoint Object ClosestPoint))    (setq ClosestPoint (trans ClosestPoint 0 1)) ; convert to UCS    (setq End (vlax-curve-getEndparam Object))    (setq P1 0.0 P2 Sample Defl 0.0)    (setq a1 (angle PIQ (trans Start 0 1))) ; in UCS    (while (<= P2 End)      (setq P2 (min P2 End))      ;; This little extra makes sure not to skip an angle      ;; that might throw off the total deflection.      ;; Moved to near top of while loop in case ClosestParam      ;; is less than the first sample.      (if (< P1 ClosestParam P2)        (setq a2 (angle PIQ ClosestPoint)              Defl (+ Defl (@delta a1 a2))              a1 a2        )      )      ;; The following (while) loop takes care of      ;; coincident adjacent vertices.      (while (not (setq P (vlax-curve-getPointAtParam Object P2)))        (setq P2 (+ P2 Sample))      )      (setq a2 (angle PIQ (trans P 0 1)) ; in UCS          Defl (+ Defl (@delta a1 a2))          a1 a2          P1 P2          P2 (+ P2 Sample)      )    )    ;(print Defl) ; Optional display of results    (> (abs Defl) 4)  ))(defun C:ITest ( / Object P)  (if (setq Object (car (entsel "\nSelect curve: ")))    (while (setq P (getpoint "\nPoint: "))      (prin1 (@Inside P Object))    )  )  (princ))`

#### LE

• Guest ##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #7 on: November 23, 2005, 10:41:21 PM »
Here is a test I did on those days too.... it is very mickey-mouse solution.... just to post it....

Code: [Select]
`;;; 9/4/03 by Luis Esquivel(defun point-inside-region-p       (vla_poly pt aid-pt pts / vla_line lst_value param result)  (setq    result     (if       (and (not (vl-position (list (car pt) (cadr pt)) pts))     (not       (vl-catch-all-error-p (setq lst_value        (vl-catch-all-apply 'vlax-safearray->list (list (vlax-variant-value (vla-intersectwith    vla_poly    (setq vla_line   (vla-addline     (vla-objectidtoobject       (vla-get-document vla_poly)       (vla-get-ownerid vla_poly))     (vlax-3d-point pt)     (vlax-3d-point aid-pt)))    acextendnone)))))))) (fix (/ (length lst_value) 3.0))))  (vl-catch-all-apply 'vla-delete (list vla_line))  (if (and (setq param (vlax-curve-getparamatpoint vla_poly pt))    (eq (type (- param (fix param))) 'real))    (setq result nil))  result)(defun C:TEST  (/ ent elst pt vla_poly lc uc flag)  (if    (and (setq ent (car (entsel "\nSelect a polyline: "))) (eq (cdadr (setq elst (entget ent))) "LWPOLYLINE") (eq (vla-get-closed        (setq vla_poly (vlax-ename->vla-object ent)))      :vlax-true) (setq pt (getpoint "\nTest point: ")))     (progn       (vla-getboundingbox vla_poly 'lc 'uc)       (if (setq      flag       (point-inside-region-p vla_poly pt (polar pt        (/ pi 2.0)        (distance (vlax-safearray->list lc) (vlax-safearray->list uc))) (mapcar   'cdr   (vl-remove-if-not     (function (lambda (item) (eq (car item) 10)))     elst)))) (not (zerop (rem flag 2)))))))(princ)`

#### Kerry ##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #8 on: November 23, 2005, 11:13:27 PM »
I use a solution similar to Luis's 'Mickey Mouse' one :-
Code: [Select]
`(defun c:test ( / ANGLESTEP INSIDE MSPACE OPLINE ORAY OTESTPOINT TESTPOINT TMP)  (setq mspace    (vla-get-modelspace                    (vla-get-activedocument (vlax-get-acad-object))                  )        oPline    (vlax-ename->vla-object (car (entsel "\nSelect LWPolyline")))        TestPoint (getpoint "\nSpecify Test Point")  )  (setq    anglestep 0    inside 0    oTestPoint     (vlax-3d-point TestPoint)  )  (repeat 24    (setq anglestep (+ 15 anglestep))    (if      (= 0         (rem (vlax-safearray-get-u-bound                (vlax-variant-value                  (setq tmp (vla-intersectwith                              oPline                              (setq                                oRay (vla-addray                                       mspace                                       oTestPoint                                       (vlax-3d-point                                         (polar TestPoint                                                (* pi (/ anglestep 180.0))                                                100                                         )                                       )                                     )                              )                              acExtendNone                            )                  )                )                1              )              2         )      )       (setq inside (1+ inside))       ;; else       (setq inside (1- inside))    )    (vla-delete oRay)      )  (if (minusp inside)    (alert " Point is outside")    (alert " Point is inside")  ))`
« Last Edit: November 23, 2005, 11:24:16 PM by Kerry Brown »
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

#### Kerry ##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #9 on: November 23, 2005, 11:28:48 PM »
Hi Zoltan,
This is based on the theory that a ray from the 'point' inside the shape will pass through the boundary an odd number of times.

The repeats are in case the point is on a vertex or segment, or if the ray is linear with a segment.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

#### Kerry ##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #10 on: November 24, 2005, 12:42:13 AM »
.. and just to cover some bases :-

The posted code makes some assumptions about UCS's and ECS's and Spaces and Closed Polylines and errors Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

#### zoltan

• Newt
• Posts: 188 ##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #11 on: November 24, 2005, 02:25:51 AM »
I'm going to have to look at these with fresh eyes tomorrow. See you in the morning.

#### hudster ##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #12 on: November 24, 2005, 03:28:32 AM »
now my head hurts Revit BDS 2017, 2016, 2015, 2014, AutoCAD 2017, 2016, Navisworks 2017, 2016, BIM360 Glue

#### Kerry ##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #13 on: November 24, 2005, 04:05:07 AM »
Thinking further on this, I'd be interested in seeing a pure math based solution not requiring interaction with the database < as such>
.. so Zoltan's original methodology may have to be revisited < and translated, please >

... so we wouldn't want to consider bulges .. yes ? « Last Edit: November 24, 2005, 04:12:43 AM by Kerry Brown »
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

#### Joe Burke

• Guest ##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #14 on: November 24, 2005, 04:49:55 AM »
Just my two cents regarding what Luis posted by John Uhden. Notice Doug Broad is
mentioned in John's comments. In fact they both worked on the problem and
developed independant solutions.

John and Doug are smart guys and first class programmers. Why reinvent the
wheel?

BTW, John had a reason for abandoning the ray method. I don't recall exactly
what it was. Hence his comment, "LOOK, MA'... NO RAYS!"

Luis, I'm pretty sure this is the final version. Note the function name is not
the same and the version numbers.

Code: [Select]
`(defun @cv_inside (PIQ Object Draw / IsPolyline Closest Start End Param P ClosestParam                                     NextParam a1 a2 Defl @2D @Insect @Bulge @Deflect                                     @Closest Color)  ;;               "LOOK, MA'... NO RAYS!"  ;; @Inside.lsp v1.0 (09-15-03) John F. Uhden, Cadlantic.  ;; v2.0 Revised (09-17-03) - See notes below.  ;; v3.0 Revised (09-20-03) - See notes below.  ;; v4.0 Revised (09-20-04) but still missing something  ;; v5.0 Revised (04-04-04) - See notes below.  ;; Function to determine whether a point is inside the boundary  ;; of a closed curve.  ;; It employs the theorem that the sum of the deflections of a  ;; point inside the curve should equal 360°, and if outside 0°  ;; (both absolute values).  ;;  ;; Arguments:  ;;   PIQ    - Point to test (2D or 3D point as a list in UCS)  ;;   Object - Curve to test (Ename or VLA-Object)  ;;   Draw   - Option to draw vectors to sample points, nil or non-nil  ;;  ;; Returns:  ;;   T   (if the PIQ is inside the curve)  ;;   nil (if either the arguments are invalid,  ;;       or the PIQ is on or outside the curve)  ;;  ;; NOTES:  ;;   Requires one or another version of the @delta function,  ;;     such as included here.  ;;   It will not work well with self-intersecting (overlapping)  ;;     bulged polyline segments.  ;;   Curves can be CIRCLEs, ELLIPSEs, LWPOLYLINEs, POLYLINES,  ;;     SPLINEs, and maybe even more.  ;;   Since all the calulations are based on angles relative to the  ;;     current UCS, there shouldn't be any limitation caused by differences  ;;     in elevation, but it is not suited for abnormal extrusion directions.  ;;   (09-17-03) Found that cusps brought back inside the figure  ;;     yield a total deflection of (* pi 2), so changed evaluation  ;;     to see if deflection was greater than 4, which is  ;;     equivalent to a fuzz factor of 2.28 from (* pi 2).  ;;   (09-20-03) Found that bulged polyline segments needed special  ;;     attention to determine the closest point to any segment because  ;;     it might not be the closest point to the object, but must be  ;;     evaluated to sample sufficient points.  ;;   (04-04-04) Renamed to original @cv_Inside.lsp (c. 2002)  ;;     Remembered there was an issue with splines, so included is a  ;;     Closest evaluation, and a small sample increment, Though I still  ;;     don't trust the results when the PIQ is near a sharp curve.  If splines  ;;     important then make the sample rate tighter at the expense of speed.  ;;     For polylines, the sample increment just 1.0 as there is a special  ;;     subfunction to pick up the midpoint and closest point of bulged segments.  ;;     For objects such as circles and ellipses the sample increment should be  ;;     a multiple of pi to achieve a total deflection that is a multiple of pi  ;;     with in a small fuzz factor.  ;;     Yes, circles and ellipses can be evaluated more easily by a simple  ;;     comparison of distances to their center, but this function is  ;;     intended to treat them as just another curve and to demonstrate  ;;     the method of using curve parameters and deflections.  (vl-load-com)  ;; Subunction to determine the deflection angle in radians beween two given angles  (or (= (type @delta) 'SUBR)    (defun @delta (a1 a2)      (cond        ((> a1 (+ a2 pi))          (+ a2 pi pi (- a1))        )        ((> a2 (+ a1 pi))          (- a2 a1 pi pi)        )        (1 (- a2 a1))      )    )  )  ;; Subfunction to convert a 3D point into 2D for the purpose  ;; of ignoring the Z value.  ;; Added (09-20-03)  (defun @2D (p)(list (car p)(cadr p)))  ;;--------------------------------------------------------  ;; Subfunction to determine if an angle is with the sector  ;; defined by two other angles.  (defun @Insect (Ang Ba Ea)    (if (> Ba Ea)      (cond        ((>= Ang Ba))        ((<= Ang Ea))        (1 nil)      )      (< Ba Ang Ea)    )  )  ;; Subfunction to find the closest point to an object from a given point,  ;; adjusted for elevation differences.  Input and output are in UCS  (defun @Closest (P / P1 P2)    (setq P (trans P 1 0)          P2 P    )    (while (not (equal P1 P2 1e-10))      (setq P1 P2            P2 (vlax-curve-GetClosestPointTo Object P)            P (list (car P)(cadr P)(last P2))      )    )    (trans P2 0 1)  )  ;; Subfunction to emulate the GetBulge method, which can be used only  ;; for simple polylines, not for fit-curved or splined.  ;; Its dual purpose here is to find a point on a bulged segment closest to  ;; the PIQ if it is within the bulge's sector and/or the midpoint of  ;; the bulged segment, and to compute deflections to same in ascending  ;; parameter order.  (defun @Bulge (Param / V1 V2 P1 P2 Center Ba Ea Ma MidParam Delta Radius Swap Ang P)    (and ;; once again the Koster approach      (< Param End)      (setq Param (fix Param))      (setq MidParam (+ Param 0.5))      (setq V1 (vlax-curve-getpointatparam Object Param))      (setq V2 (vlax-curve-getpointatparam Object MidParam))      (setq Ba (apply 'atan (reverse (@2d (vlax-curve-getSecondDeriv Object Param)))))      (setq Ea (apply 'atan (reverse (@2d (vlax-curve-getSecondDeriv Object MidParam)))))      (not (equal Ba Ea 1e-8))      (setq P1 (polar V1 Ba 1.0))      (setq P2 (polar V2 Ea 1.0))      (setq Center (inters V1 P1 V2 P2 nil))      (setq Radius (distance Center V1))      (setq Ba (angle Center V1)) ; Beginning angle      (setq V2 (vlax-curve-getpointatparam Object (1+ Param)))      (setq Ea (angle Center V2)) ; End angle      (setq Ma (angle Center (vlax-curve-getpointatparam Object MidParam))) ; Mid angle      (setq MidP (trans (vlax-curve-GetPointAtParam Object MidParam) 0 1))      ;; Since we don't have the value of bulge, and since the internal angle (Delta)      ;; can be > pi, cut the segment in half and add up the separate deflections:      (setq Delta (+ (@delta Ba Ma)(@delta Ma Ea)))      ;; If you had a Tan function, then you could      ;; (setq Bulge (Tan (/ Delta 4)))      (or        (> Delta 0)        (setq Swap Ba Ba Ea Ea Swap)      )      (setq Ang (angle Center (trans PIQ 1 0)))      (if (@Insect Ang Ba Ea)        (setq P (trans (polar Center Ang Radius) 0 1)              P (@Closest P)              PParam (vlax-curve-GetParamAtPoint Object (trans P 1 0))        )      )      (cond        ((or (not PParam)(= PParam MidParam))          (@Deflect MidP 3) ; in UCS        )        ((< PParam MidParam)          (@Deflect P 1) ; in UCS          (@Deflect MidP 3) ; in UCS        )        ((> PParam MidParam)          (@Deflect MidP 3) ; in UCS          (@Deflect P 1) ; in UCS        )      )    )  )  (defun @Deflect (P Color)    (setq a2   (angle PIQ P) ; in UCS          Defl (+ Defl (@delta a1 a2))          a1 a2    )    (if Draw (grdraw PIQ P Color))  )  ;;=========================================================  ;; Begin input validation and processing using the  ;; Steph(and) Koster approach which simply stops evaluating  ;; on any nil result:  (and    ;; Validate input object:    (cond      ((not Object)        (prompt "  No object provided.")      )      ((= (type Object) 'VLA-Object))      ((= (type Object) 'Ename)        (setq Object (vlax-ename->vla-object Object))      )      (1 (prompt "  Improper object type."))    )    ;; Validate input point:    (or      (and        (< 1 (vl-list-length PIQ) 4)        (vl-every 'numberp PIQ)      )      (prompt " Improper point value.")    )    ;; Validate that object is a curve:    (or      (not        (vl-catch-all-error-p          (setq Start            (vl-catch-all-apply              'vlax-curve-getStartPoint              (list Object)            )          )        )      )      (prompt "  Object is not a curve.")    )    ;; Validate that curve is closed:    (or      (equal Start (vlax-curve-getendpoint Object) 1e-10)      (prompt "  Curve is not closed.")    )    (setq Closest (@Closest PIQ)) ; in UCS    ;; Test to see if PIQ is on object:    (not (equal (@2D PIQ)(@2D Closest) 1e-10)) ; in WCS    (setq ClosestParam (vlax-curve-getparamatpoint Object (trans Closest 1 0)))    (or (not Draw)(not (grdraw PIQ Closest 2)))    (setq IsPolyline (wcmatch (vla-get-objectname Object) "*Polyline")          End (vlax-curve-getEndparam Object)    )    ;; Set the sample rates based on object type and end parameter.    (cond      (IsPolyline        (setq ClosestParam nil)        (setq Sample 1.0)      )      ((equal (rem End pi) 0.0 1e-10)        (setq Sample (* pi 0.2))      )      ((setq Sample (* End 0.01)))    )    ;; Initialize the values to be incremented and computed:    (setq Param Sample Defl 0.0)    (setq a1 (angle PIQ (trans Start 0 1))) ; in UCS    ;; Iterate through the object by parameter:    (while (<= Param End)      (setq Param (min Param End))      ;; This little extra makes sure not to skip an angle      ;; that might throw off the total deflection.      ;; It is at the top of while loop in case ClosestParam      ;; is less than the first sample.      ;; This is not to be used with polylines.      (if (and ClosestParam (> Param ClosestParam))        (setq P Closest              ClosestParam nil              NextParam Param              Color 2        )        (setq P (trans (vlax-curve-getpointatparam Object Param) 0 1)              NextParam (+ Param Sample)              Color 3        )      )      (@Deflect P Color) ; in UCS      ;; For polylines check for additional points on any      ;; bulged segment.      (if IsPolyline (@Bulge Param))      (setq Param NextParam)    )    (if Draw (print Defl)) ; Optional display of results    (> (abs Defl) 4) ; to allow for rough calculations if                     ; sample rates are too high (large).  ));; Testing command function:(defun C:ITest ( / Object P)  (redraw)  (if (setq Object (car (entsel "\nSelect curve: ")))    (while (setq P (getpoint "\nPoint: "))      (redraw)      (prin1 (@cv_inside P Object 1))    )  )  (princ))`