http://bbs.xdcad.net/thread-711543-1-2.htmlImports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.EditorInput
Public Class Class1
Enum IncidenceType
kIncidenceToLeft = 0
kIncidenceToRight
kIncidenceToFront
kIncidenceUnknown
End Enum
Private Function CurveIncidence(ByVal curve As Curve, ByVal param As Double, ByVal dir As Vector3d, ByVal normal As Vector3d) As IncidenceType
Dim deriv1 As Vector3d = curve.GetFirstDerivative(param)
If deriv1.IsParallelTo(dir) Then
' need second degree analysis
Dim deriv2 As Vector3d = curve.GetSecondDerivative(param)
If deriv2.IsZeroLength() OrElse deriv2.IsParallelTo(dir) Then
Return IncidenceType.kIncidenceToFront
Else
If deriv2.CrossProduct(dir).DotProduct(normal) < 0 Then
Return IncidenceType.kIncidenceToRight
Else
Return IncidenceType.kIncidenceToLeft
End If
End If
End If
If deriv1.CrossProduct(dir).DotProduct(normal) < 0 Then
Return IncidenceType.kIncidenceToLeft
Else
Return IncidenceType.kIncidenceToRight
End If
End Function
Private Function IsInsideCurve(ByVal curve As Curve, ByVal testPt As Point3d) As Boolean
If Not curve.Closed Then
' cannot be inside
Return False
End If
Dim ptOnCurve As Point3d = curve.GetClosestPointTo(testPt, False)
If testPt = ptOnCurve Then
Return True
End If
If Not curve.IsPlanar Then
Return False
End If
' check its planar
Dim plane As Plane = curve.GetPlane()
' make the test ray from the plane
Dim epsilon As Double = 0.000002
' ( trust me on this )
Dim IntersectionPoints As New Point3dCollection()
Dim normal As Vector3d = plane.Normal
Dim testVector As Vector3d = normal.GetPerpendicularVector()
Using ray As New Ray()
ray.BasePoint = testPt
Dim nGlancingHits As Integer = 0, numberOfInters As Integer = 0
Dim bRetryWithOtherRayDirection As Boolean
Do
bRetryWithOtherRayDirection = False
IntersectionPoints.Clear()
ray.UnitDir = testVector
' fire the ray at the curve
curve.IntersectWith(ray, Intersect.OnBothOperands, IntersectionPoints, IntPtr.Zero, IntPtr.Zero)
numberOfInters = IntersectionPoints.Count
If numberOfInters = 0 Then
Return False
End If
nGlancingHits = 0
Dim i As Integer = 0
While i < IntersectionPoints.Count
Dim hitParam As Double
Try
'This try/catch block circumvents an issue with GetParameterAtPoint API
hitParam = curve.GetParameterAtPoint(IntersectionPoints(i))
Catch
bRetryWithOtherRayDirection = True
testVector = testVector.RotateBy(5.0 * Math.PI / 180.0, normal)
Exit Try
End Try
Dim inParam As Double = hitParam - epsilon
Dim outParam As Double = hitParam + epsilon
'Loop back inside the curve if param is falling outside of range
If inParam < curve.StartParam Then
inParam = curve.EndParam - epsilon + (curve.StartParam - inParam)
End If
If outParam > curve.EndParam Then
outParam = curve.StartParam + epsilon + (curve.EndParam - outParam)
End If
Dim inIncidence As IncidenceType = CurveIncidence(curve, inParam, testVector, normal)
Dim outIncidence As IncidenceType = CurveIncidence(curve, outParam, testVector, normal)
If inIncidence = IncidenceType.kIncidenceToFront OrElse outIncidence = IncidenceType.kIncidenceToFront Then
bRetryWithOtherRayDirection = True
testVector = testVector.RotateBy(5.0 * Math.PI / 180.0, normal)
Exit While
End If
If (inIncidence = IncidenceType.kIncidenceToRight AndAlso outIncidence = IncidenceType.kIncidenceToLeft) OrElse (inIncidence = IncidenceType.kIncidenceToLeft AndAlso outIncidence = IncidenceType.kIncidenceToRight) Then
nGlancingHits += 1
End If
System.Threading.Interlocked.Increment(i)
End While
Loop While bRetryWithOtherRayDirection
Return ((numberOfInters + nGlancingHits) Mod 2 = 1)
End Using
End Function
<CommandMethod("TestIsInsideCurve")> _
Public Sub TestIsInsideCurve()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim peo As New PromptEntityOptions(vbLf & "Select a Curve: ")
peo.SetRejectMessage(vbLf & "Invalid selection...")
peo.AddAllowedClass(GetType(Curve), False)
Dim per As PromptEntityResult = ed.GetEntity(peo)
If per.Status <> PromptStatus.OK Then
Return
End If
Dim ppr As PromptPointResult = ed.GetPoint(vbLf & "Pick a point")
If ppr.Status <> PromptStatus.OK Then
Return
End If
Using Tx As Transaction = db.TransactionManager.StartTransaction()
Dim curve As Curve = TryCast(Tx.GetObject(per.ObjectId, OpenMode.ForRead), Curve)
Dim res As Boolean = IsInsideCurve(curve, ppr.Value)
ed.WriteMessage(vbLf & "Inside: " + res.ToString())
End Using
End Sub
End Class