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