Sub Test() Dim c As Double Dim sp As SubPath Set sp = ActiveShape.Curve.Subpaths(1) c = sp.GetCurveSpeedAt(0.5, cdrRelativeSegmentOffset) If Abs(c) < 0.01 Then MsgBox "Curvature is steady: " & c Else If c > 0 Then MsgBox "Curvature is increasing: " & c Else MsgBox "Curvature is decreasing: " & c End If End IfEnd Sub