All -
I presume this should be 'Project points onto polylines' not 'Project pints
onto polylines' but there you go I often fancy a pint myself.
Heres some code that works for me - its VB wrapping up MI Pro but the maths
are all there. You could easily port it to MB. It takes the x,y of a point
and drops a perpendicular onto a specified polyline (which I have turned
into a collection of points). The code is along the lines discussed on this
list over the last day or so.
I'll also post it on Directions incase anyones mail server spits it out.
The mObjInfo.Distance statement is just a call to the Distance function in
MapBasic - the clsPoint class is pretty much a type storing x and y, and
clsPoints is a custom collection class (of points) that you could
reimplement as an array of types.
Public Function ReturnPointOfShortestPerpendicular(ByVal pt As clsPoint, _
ByVal pts As
clsPoints, _
ptPerpendicular As
clsPoint) As Boolean
'*****************************************************
' Purpose: Routine to return the end point of the perpendicular
' on to nearest line segment from a point
' Inputs: Point, points collection from line
'
' Returns: by ref point
'*************************
On Error GoTo labelError
Dim i As Integer
Dim ptTemp As New clsPoint
Dim intCount As Integer
Dim iClosestPoint As Integer
Dim dblShortestDist As Double
Dim dblTempDist As Double
intCount = pts.Count
'Treat line feature line as a series of lines and get the perpendicular
onto each -
'take the shortest as the return value
'Initialise the values from the first line segment then compare each of
the rest
'Give dblShortestDist a value just in case
ptPerpendicular.SetXY pts(1).X, pts(1).Y
dblShortestDist = Sqr((pt.X - pts(1).X) ^ 2 + (pt.Y - pts(1).Y) ^ 2)
iClosestPoint = 1
For i = 1 To intCount - 1
If FindClosestPointOnLineSegment(pt, pts(i), pts(i + 1), ptTemp) Then
dblTempDist = mObjInfo.Distance(pt, ptTemp)
If dblTempDist < dblShortestDist Then
dblShortestDist = dblTempDist
ptPerpendicular.SetXY ptTemp.X, ptTemp.Y
iClosestPoint = i
End If
End If
Next
ReturnPointOfShortestPerpendicular = True
Exit Function
labelError:
ReturnPointOfShortestPerpendicular = False
Call ErrorHandler("GenericUtils: ReturnPointOfShortestPerpendicular")
End Function
Public Function FindClosestPointOnLineSegment(ptNearbyPoint As clsPoint, _
ByVal ptLineSegmentEnd1 As clsPoint,
_
ByVal ptLineSegmentEnd2 As clsPoint,
_
ptClosestPoint As clsPoint) As
Boolean
'*****************************************************
' Purpose: Generic Routine to take three points, two on a line and
' the other to one side, and return the closest point on the
line
' i.e. give a point where the perpendicular from the third point
will fall
' on the line
' Inputs: three points
'
' Returns: boolean - closest point by ref
'*************************
Dim dblX As Double
Dim dblX2 As Double
Dim dblY As Double
Dim dblY2 As Double
Dim dblDeltaX As Double
Dim dblDeltaY As Double
Dim dblReturnX As Double
Dim dblReturnY As Double
Dim dblM As Double
Dim dblC As Double
Dim dblD As Double
Dim dblTempDist1 As Double
Dim dblTempDist2 As Double
On Error GoTo labelError
'If the point is close enough to either of the segment ends then return
them
FindClosestPointOnLineSegment = False
If Abs(ptLineSegmentEnd1.X - ptNearbyPoint.X) < 0.1 And _
Abs(ptLineSegmentEnd1.Y - ptNearbyPoint.Y) < 0.1 Then
'its within 10cm - this will do
ptClosestPoint.SetXY ptLineSegmentEnd1.X, ptLineSegmentEnd1.Y
FindClosestPointOnLineSegment = True
Exit Function
End If
If Abs(ptLineSegmentEnd2.X - ptNearbyPoint.X) < 0.1 And _
Abs(ptLineSegmentEnd2.Y - ptNearbyPoint.Y) < 0.1 Then
'its within 10cm - this will do
ptClosestPoint.SetXY ptLineSegmentEnd2.X, ptLineSegmentEnd2.Y
FindClosestPointOnLineSegment = True
Exit Function
End If
'Otherwise we need to do some maths
'Get the numbers into the right order - mdblMapX2 needs to be bigger
If ptLineSegmentEnd1.X > ptLineSegmentEnd2.X Then
dblX = ptLineSegmentEnd2.X
dblX2 = ptLineSegmentEnd1.X
dblY = ptLineSegmentEnd2.Y
dblY2 = ptLineSegmentEnd1.Y
Else
dblX = ptLineSegmentEnd1.X
dblX2 = ptLineSegmentEnd2.X
dblY = ptLineSegmentEnd1.Y
dblY2 = ptLineSegmentEnd2.Y
End If
dblDeltaX = dblX2 - dblX
dblDeltaY = dblY2 - dblY
If dblDeltaX = 0 Then 'Vertical line
dblReturnX = dblX2
'Y value can be same as the existing point
dblReturnY = ptNearbyPoint.Y
ElseIf dblDeltaY = 0 Then 'horizontal line
dblReturnY = dblY2
'X value can be the same as the existing point
dblReturnX = ptNearbyPoint.X
Else
dblM = dblDeltaY / dblDeltaX
dblC = dblY - (dblM * dblX)
dblD = ptNearbyPoint.Y + (ptNearbyPoint.X / dblM)
'Now do the new coords
dblReturnX = (dblD - dblC) / (dblM + (1 / dblM))
dblReturnY = (dblM * dblReturnX) + dblC
End If
ptClosestPoint.SetXY dblReturnX, dblReturnY
'Check this closest point is actually between the other two
If Not PointIsBetween(ptLineSegmentEnd1, ptLineSegmentEnd2,
ptClosestPoint) Then
'The nearest point on that segment is actually one of the vertices
dblTempDist1 = mObjInfo.Distance(ptClosestPoint, ptLineSegmentEnd1)
dblTempDist2 = mObjInfo.Distance(ptClosestPoint, ptLineSegmentEnd2)
If dblTempDist1 < dblTempDist2 Then
ptClosestPoint.SetXY ptLineSegmentEnd1.X, ptLineSegmentEnd1.Y
Else
ptClosestPoint.SetXY ptLineSegmentEnd2.X, ptLineSegmentEnd2.Y
End If 'Vertex 1 is close
End If 'Returned point is not on line segment
FindClosestPointOnLineSegment = True
Exit Function
labelError:
FindClosestPointOnLineSegment = False
Call ErrorHandler("FindClosestPointOnLineSegment")
End Function
Public Function PointIsBetween(ByVal pt1 As clsPoint, ByVal pt2 As clsPoint,
_
ByVal ptInBetween As clsPoint) As Boolean
'*****************************************************
' Purpose: Routine to check whether a point falls between two others
' Inputs: Three Points
'
' Returns: boolean
'*************************
On Error GoTo labelError
Dim dblMapX As Double
Dim dblMapX2 As Double
Dim dblMapY As Double
Dim dblMapY2 As Double
PointIsBetween = False
'Sort the values so x2, y2 are the larger
If pt1.X > pt2.X Then
dblMapX = pt2.X
dblMapX2 = pt1.X
Else
dblMapX = pt1.X
dblMapX2 = pt2.X
End If
If pt1.Y > pt2.Y Then
dblMapY = pt2.Y
dblMapY2 = pt1.Y
Else
dblMapY = pt1.Y
dblMapY2 = pt2.Y
End If
'Use a 10cm tolerance and see if the point falls between the other two
If (ptInBetween.X + 0.1 >= dblMapX) And (ptInBetween.X - 0.1 <= dblMapX2)
And _
(ptInBetween.Y + 0.1 >= dblMapY) And (ptInBetween.Y - 0.1 <= dblMapY2)
Then
PointIsBetween = True
End If
Exit Function
labelError:
PointIsBetween = False
Call ErrorHandler("GenericUtils: PointIsBetween")
End Function
********************************************************************
This email may contain information which is privileged or confidential. If you are not
the intended recipient of this email, please notify the sender immediately and delete
it without reading, copying, storing, forwarding or disclosing its contents to any
other person
Thank you
Check us out at http://www.syntegra.com
********************************************************************
