PDA

View Full Version : Point at some distance between 2 points - best practice?

KevinBarnett
2004-07-09, 05:47 AM
Greetings Gang,

I needed a function to find a point at a specific distance between two points and wrote the included code. Can the code be reduced/improved? Is there a quicker method to do this?

TIA,

Kevin.

Public Function PntByVector(FromPnt As Variant, ToPnt As Variant, VDist As Double) _
As Variant

Dim DDist As Double 'direct distance

DDist = ADistance(FromPnt, ToPnt)

If VDist > DDist Then
'send error back... ???
Exit Function
End If

Dim FDist As Double 'flat distance
Dim BDist As Double 'flat eq of req. dist
Dim Ang As Double
Dim Pnt As Variant

If (ToPnt(2) - FromPnt(2)) <> 0 Then
FDist = Sqr((DDist ^ 2) - ((ToPnt(2) - FromPnt(2)) ^ 2))
Ang = Atn((ToPnt(2) - FromPnt(2)) / FDist)
BDist = Cos(Ang) * VDist
Pnt = ThisDrawing.Utility.PolarPoint(FromPnt, _
ThisDrawing.Utility.AngleFromXAxis(FromPnt, ToPnt), BDist)
Pnt(2) = Pnt(2) + (Sin(Ang) * VDist)
PntByVector = Pnt
Else
Pnt = ThisDrawing.Utility.PolarPoint(FromPnt, _
ThisDrawing.Utility.AngleFromXAxis(FromPnt, ToPnt), VDist)
PntByVector = Pnt
End If
End Function

Public Function ADistance(P1 As Variant, P2 As Variant) As Double
Dim x, Y, Z As Double
x = P1(0) - P2(0)
Y = P1(1) - P2(1)
If UBound(P1) > 1 And UBound(P2) > 1 Then
Z = P1(2) - P2(2)
ADistance = Abs(Sqr((Sqr((x ^ 2) + (Y ^ 2)) ^ 2) + (Z ^ 2)))
Else
ADistance = Abs(Sqr((x ^ 2) + (Y ^ 2)))
End If
End Function