'Круг, вписанный 4-угольника, в него 8-угольника и 4-угольник
 

Sub Macro1()
    M = 0.25
    r = 10 * M     xc = 16 * M
    yc = 29 * M
    x1 = xc - r
    y1 = yc - r
    x2 = xc + r
    y2 = yc + r
    Dim s51 As Shape
    Set s51 = ActiveLayer.CreateEllipse(x1, y1, x2, y2, 90#, 90#, False)
    ' s51.Fill.UniformColor.CMYKAssign 255, 0, 0, 0   ' ?????
    s51.Fill.UniformColor.RGBAssign 88, 197, 240

    a = 2 * Sqr(r * r / 2)     x1 = (-a / 2) + xc
    y1 = (-a / 2) + yc
    Dim s644 As Shape
    Dim crvs644 As Curve
    Set crvs644 = CreateCurve(ActiveDocument)
    With crvs644.CreateSubPath(x1, y1)
        .AppendLineSegment x1 + a, y1
        .AppendLineSegment x1 + a, y1 + a
        .AppendLineSegment x1, y1 + a
        .AppendLineSegment x1, y1
        .Closed = True
    End With
    Set s644 = ActiveLayer.CreateCurve(crvs644)
    ' s644.Fill.UniformColor.CMYKAssign 0, 255, 0, 0
    s644.Fill.UniformColor.RGBAssign 255, 0, 0

  r = a / 2
    PI = 3.14
    ug0 = 0
    step = PI / 4
    i = 0
        ug = ug0 + i * step
        x1 = xc + r * Sin(ug)
        y1 = yc + r * Cos(ug)
        i = 1
        ug = ug0 + i * step
        x2 = xc + r * Sin(ug)
        y2 = yc + r * Cos(ug)
        i = 2
        ug = ug0 + i * step
        x3 = xc + r * Sin(ug)
        y3 = yc + r * Cos(ug)
        i = 3
        ug = ug0 + i * step
        x4 = xc + r * Sin(ug)
        y4 = yc + r * Cos(ug)
        i = 4
        ug = ug0 + i * step
        x5 = xc + r * Sin(ug)
        y5 = yc + r * Cos(ug)
        i = 5
        ug = ug0 + i * step
        x6 = xc + r * Sin(ug)
        y6 = yc + r * Cos(ug)
        i = 6
        ug = ug0 + i * step
        x7 = xc + r * Sin(ug)
        y7 = yc + r * Cos(ug)
        i = 7
        ug = ug0 + i * step
        x8 = xc + r * Sin(ug)
        y8 = yc + r * Cos(ug)
 
    Dim s645 As Shape
    Dim crvs645 As Curve
    Set crvs645 = CreateCurve(ActiveDocument)
    With crvs645.CreateSubPath(x1, y1)
        .AppendLineSegment x2, y2
        .AppendLineSegment x3, y3
        .AppendLineSegment x4, y4
        .AppendLineSegment x5, y5
        .AppendLineSegment x6, y6
        .AppendLineSegment x7, y7
        .AppendLineSegment x8, y8
        .AppendLineSegment x1, y1
        .Closed = True
    End With
    Set s645 = ActiveLayer.CreateCurve(crvs645)
    s645.Fill.UniformColor.CMYKAssign 0, 0, 255, 0 ' ??????
 
    a = 2 * Sqr(r * r / 2)
   x1 = (-a / 2) + xc
    y1 = (-a / 2) + yc
    Dim s646 As Shape
    Dim crvs646 As Curve
    Set crvs646 = CreateCurve(ActiveDocument)
    With crvs646.CreateSubPath(x1, y1)
        .AppendLineSegment x1 + a, y1
        .AppendLineSegment x1 + a, y1 + a
        .AppendLineSegment x1, y1 + a
        .AppendLineSegment x1, y1
        .Closed = True
    End With
    Set s646 = ActiveLayer.CreateCurve(crvs646)
    s646.Fill.UniformColor.CMYKAssign 255, 0, 0, 0
 
End Sub