Sub Test() Dim seg1 As Segment, seg2 As Segment Dim cps As CrossPoints, cp As CrossPoint Dim x As Double, y As Double If ActiveShape Is Nothing Then MsgBox "Nothing selected", vbCritical Exit Sub End If If ActiveShape.Type <> cdrCurveShape Then MsgBox "Select a curve", vbCritical Exit Sub End If If ActiveShape.Curve.Subpaths.Count < 2 Then MsgBox "The curve must have 2 subpaths", vbCritical Exit Sub End If Set seg1 = ActiveShape.Curve.Subpaths(1).Segments(1) Set seg2 = ActiveShape.Curve.Subpaths(2).Segments(1) Set cps = seg1.GetIntersections(seg2) For Each cp In cps ActiveLayer.CreateEllipse2 cp.PositionX, cp.PositionY, 0.05 Next cp MsgBox cps.Count & " intersection point(s) found"End Sub