Sub Test() Dim s1 As Shape, s2 As Shape, sCurve As Shape Dim c As Curve Set s1 = ActiveDocument.ActiveLayer.CreateEllipse2(4, 6.5, 0.5) Set s2 = ActiveDocument.ActiveLayer.CreateEllipse2(4, 5, 1) s1.Fill.ApplyUniformFill CreateRGBColor(255, 0, 0) s2.Fill.ApplyUniformFill CreateRGBColor(0, 0, 255) Set c = New Curve c.BindToDocument ActiveDocument c.AppendCurve s1.DisplayCurve c.AppendCurve s2.DisplayCurve Set sCurve = ActiveLayer.CreateCurve(c) sCurve.Move 1, 1 sCurve.Fill.ApplyUniformFill CreateRGBColor(0, 255, 0)End Sub