Here's a Vba way, it was a little harder to do this than I thought as I already had it's mate, getting the point at distance.
Option Explicit
Const PI As Double = 3.14159265358979
Sub TestPt()
Dim oPline As AcadLWPolyline
Dim Util As AcadUtility
Dim Varpick As Variant
Set Util = ThisDrawing.Utility
Util.GetEntity oPline, Varpick, "Pick a poly:"
Varpick = ThisDrawing.Utility.GetPoint(, "Point on poly")
Debug.Print LengthAtPointOnPoly(oPline, Varpick)
End Sub
Function LengthAtPointOnPoly(oPline As AcadLWPolyline, Varpick As Variant) As Double
Dim Dist As Double, TotalDist As Double
Dim dBulge As Double, seg As Double
Dim Pt(1) As Double
Dim C1, C2
Dim Ct As Integer, i As Long
Dim Util As AcadUtility
Set Util = ThisDrawing.Utility
Varpick = Util.TranslateCoordinates(Varpick, acWorld, acOCS, False, oPline.Normal)
If Not Rd(Varpick(2), oPline.Elevation) Then Exit Function
Pt(0) = Varpick(0): Pt(1) = Varpick(1)
Ct = (UBound(oPline.Coordinates) - 1) / 2
If oPline.Closed = True Then Ct = Ct + 1
ReDim Coords(Ct) As Variant
For i = 0 To Ct - 1
Coords(i) = oPline.Coordinate(i)
Next
If oPline.Closed = True Then
Coords(Ct) = oPline.Coordinate(0)
Else
Coords(Ct) = oPline.Coordinate(Ct)
End If
For i = 0 To Ct - 1
C1 = Coords(i)
C2 = Coords(i + 1)
dBulge = oPline.GetBulge(i)
seg = Length(C1, C2)
If dBulge = 0 Then
If isOnLine(C1, C2, Pt) Then
TotalDist = TotalDist + Length(C1, Pt)
Exit For
Else
TotalDist = TotalDist + seg
If i = Ct - 1 Then TotalDist = 0
End If
Else
If isPtonArc(C1, C2, Pt, dBulge, seg, Dist) Then
TotalDist = TotalDist + Dist
Exit For
Else
TotalDist = TotalDist + polyarclength(dBulge, seg)
If i = Ct - 1 Then TotalDist = 0
End If
End If
Next i
LengthAtPointOnPoly = TotalDist
End Function
Private Function isPtonArc(C1 As Variant, C2 As Variant, Pt As Variant, _
dBulge As Double, seg As Double, Dist As Double) As Boolean
Dim Rad As Double
Dim X As Double, Y As Double
Dim deltaX As Double, deltaY As Double
Dim Slope As Double, Invertslope As Double
Dim dLength As Double, AngX As Double
Dim CenPt(1) As Double
Dim bOnArc As Boolean
Dim iLeft As Integer
'IncludedAng = Atn(dBulge) * 4 'converting bulge to angle in radians
Rad = seg / (2 * Sin(2 * Atn(dBulge)))
'find the midpoint
X = (C1(0) + C2(0)) / 2
Y = (C1(1) + C2(1)) / 2
deltaX = C2(0) - C1(0)
deltaY = C2(1) - C1(1)
'Convert floating point to zero
If Rd(deltaX, 0) Then deltaX = 0
If Rd(deltaY, 0) Then deltaY = 0
'The height of the curve is dBulge * 0.5 * seg
'dist is the length from the midpoint to the center
Dist = Rad - dBulge * 0.5 * seg
'If Abs(dBulge) > 1 Then Dist = -Dist
If deltaY >= 0 Then
If deltaX <> 0 Then
Dist = -Dist
End If
Else
If deltaX = 0 Then
Dist = -Dist
End If
End If
If deltaY = 0 Then 'Line p1,p2 is horizontal
CenPt(0) = X
CenPt(1) = Y - Dist
ElseIf deltaX = 0 Then 'Line p1,p2 is vertical
CenPt(0) = X - Dist
CenPt(1) = Y
Else
Slope = deltaY / deltaX
Invertslope = -1 / Slope
'Invert slope for perpendicular bisector
'X = X1 + distance / dLength * DX
'proving for DeltaX=1 in slope direction
'slope=DeltaY / 1 => DeltaY=slope
dLength = Sqr(Invertslope ^ 2 + 1)
CenPt(0) = X + (Dist / dLength) '* 1
CenPt(1) = Y + ((Dist / dLength) * Invertslope)
End If
AddPt CenPt, , 1
If Not Rd(Abs(Rad), Length(CenPt, Pt)) Then
Exit Function
'Point must be on a different segment
End If
iLeft = isLeft(C1, C2, Pt)
If dBulge > 0 Then
If iLeft < 1 Then 'On line (0) or ccw
bOnArc = True
End If
Else
If iLeft > -1 Then 'On line (0) or cw
bOnArc = True
End If
End If
If bOnArc = True Then
Dim C1pt As Double, incAng As Double
C1pt = 0.5 * Length(C1, Pt)
incAng = Abs(2 * ArcSin(C1pt / Rad))
If Sgn(isLeft(C1, CenPt, Pt)) = Sgn(dBulge) Then
incAng = 2 * PI - incAng
End If
Dist = Abs(incAng * Rad)
isPtonArc = True
End If
End Function
Private Function isOnLine(C1, C2, Pt) As Boolean
Dim deltaX As Double, deltaY As Double
Dim dLength As Double
Dim XY As Integer
Dim X As Double, Y As Double
If isLeft(C1, C2, Pt) <> 0 Then Exit Function
deltaX = C2(0) - C1(0)
deltaY = C2(1) - C1(1)
If Rd(deltaX, 0) Then deltaX = 0
If Rd(deltaY, 0) Then deltaY = 0
If deltaX = 0 Then XY = 0 'Line p1,p2 is vertical
If deltaY = 0 Then XY = 1 'Line p1,p2 is horizontal
If deltaX = 0 Or deltaY = 0 Then
If C2(XY) > C1(XY) Then
If Pt(XY) >= C1(XY) And Pt(XY) <= C2(XY) Then
isOnLine = True
End If
Else
If Pt(XY) >= C2(XY) And Pt(XY) <= C1(XY) Then
isOnLine = True
End If
End If
Exit Function
Else
X = (Pt(0) - C1(0)) / deltaX
If X >= -0.0000001 Then
If X <= 1.0000001 Then
Y = (Pt(1) - C1(1)) / deltaY
If Y >= -0.0000001 And Y <= 1.0000001 Then
isOnLine = True
End If
End If
End If
End If
End Function
Function Rd(num1 As Variant, num2 As Variant) As Boolean
Dim dRet As Double
dRet = num1 - num2
If Abs(dRet) < 0.00000001 Then Rd = True
End Function
Public Function Length(StartPoint As Variant, EndPoint As Variant) As Double
Dim Stx As Double, Sty As Double, Stz As Double
Dim Enx As Double, Eny As Double, Enz As Double
Dim dX As Double, dY As Double, dZ As Double
Dim i As Integer
If IsEmpty(StartPoint) Then Err.Raise 13
i = UBound(StartPoint)
If UBound(EndPoint) = i Then
If i > 0 Then
Stx = StartPoint(0): Sty = StartPoint(1)
Enx = EndPoint(0): Eny = EndPoint(1)
dX = Stx - Enx
dY = Sty - Eny
If i = 1 Then
Length = Sqr(dX * dX + dY * dY)
Else
Stz = StartPoint(2): Enz = EndPoint(2)
dZ = Stz - Enz
Length = Sqr((dX * dX) + (dY * dY) + (dZ * dZ))
End If
Else
Exit Function
End If
Else
Exit Function
End If
End Function
Public Function polyarclength(Bulge As Double, LengthBetweenPts As Double) As Double
'Bulge is the getbulge & LengthBetweenPts is the straight dist. between 2 verticies
Dim dAng As Double, Dist As Double
dAng = Atn(Bulge) * 4 'converting bulge to angle in radians
Dist = 0.5 * LengthBetweenPts
polyarclength = dAng * Dist / Sin(0.5 * dAng)
End Function
Public Function ArcSin(X) As Double
If Abs(X > 1) Then
MsgBox "Oops"
End If
If X = 1 Then
ArcSin = PI * 0.5
ElseIf X = -1 Then
ArcSin = -PI * 0.5
Else
ArcSin = Atn(X / Sqr(-X * X + 1))
End If
End Function
Function isLeft(LineStart, LineEnd, Pt) As Integer
Dim Ans As Double
Ans = ((LineEnd(0) - LineStart(0)) * (Pt(1) - LineStart(1)) _
- (Pt(0) - LineStart(0)) * (LineEnd(1) - LineStart(1)))
Ans = Round(Ans, 12)
If Ans > 0 Then isLeft = 1: Exit Function 'Pt is left of the line (CW)
If Ans < 0 Then isLeft = -1: Exit Function 'Pt is right of the line (CCW)
If Ans = 0 Then isLeft = 0
End Function