Sub Test() Dim c As Double, r As Double Dim x As Double, y As Double, pa As Double Dim sp As SubPath Set sp = ActiveShape.Curve.SubPaths(1) c = sp.GetCurvatureAt(0.25, cdrRelativeSegmentOffset) If Abs(c) < 0.00001 Then MsgBox "The curve is almost straight at this point", vbCritical Exit Sub End If sp.GetPointPositionAt x, y, 0.25, cdrRelativeSegmentOffset pa = sp.GetPerpendicularAt(0.25, cdrRelativeSegmentOffset) pa = pa * 3.1415926 / 180 r = 1 / c x = x + r * Cos(pa) y = y + r * Sin(pa) ActiveLayer.CreateEllipse2 x, y, rEnd Sub