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
                        ' ????? 4-????????
                        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

                    ' ?????? 8-????????
                      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 ' ??????
 
                      ' ????? 4-????????
                        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

           Sub Macro2()
 
                        Data1 = "20" ' ????
                        Data2 = "10" ' ?????
                        Data3 = "1947" ' ???
                        zz = Data1 + Data2 + Data3 ' ????, ?????, ???
                        zz = Replace(zz, "0", "") ' ?????? ????
                        nzz = Len(zz) ' ?????
 
                        MsgBox "zz = " & zz
 
                        Dim s(40)
                        For m = 1 To nzz
                          s(m) = Mid(zz, m, 1)
                         Next
 
                  Dim x(40)
                  Dim y(40)
 
                  For i = 1 To nzz
                      x(i) = orto(s(i), yi)
                      y(i) = yi
                  '    MsgBox "y{k} = " & y(k)
                  Next
 
                        Dim crvs5 As Curve
                        Set crvs5 = CreateCurve(ActiveDocument)
                        With crvs5.CreateSubPath(x(1), y(1))
                          For n = 2 To nzz
                          .AppendLineSegment x(n), y(n)
                        Next
                        .AppendLineSegment x(1), y(1)
                           .Closed = True
                        End With
                        Set s5 = ActiveLayer.CreateCurve(crvs5)
                        s5.Fill.UniformColor.RGBAssign 255, 0, 0
    End Sub

              Function orto(sn, y99)
                        m = 0.25
                        r = 10 * m
                        a = 2 * Sqr(r * r / 2)
                        r = a / 2
                        a = 2 * Sqr(r * r / 2)
                        xc = 16 * m
                        yc = 29 * m
                        x11 = xc - a / 2
                        y11 = yc + a / 2
                        x12 = xc
                        y12 = yc + a / 2
                        x13 = xc + a / 2
                        y13 = yc + a / 2
 
                        x14 = xc - a / 2
                        y14 = yc
                        x15 = xc
                        y15 = yc
                        x16 = xc + a / 2
                        y16 = yc
 
                        x17 = xc - a / 2
                        y17 = yc - a / 2
                        x18 = xc
                        y18 = yc - a / 2
                        x19 = xc + a / 2
                        y19 = yc - a / 2
 
 
                        If (sn = 1) Then
                            x1 = x11
                            y1 = y11
                        End If
                        If (sn = 2) Then
                            x1 = x12
                            y1 = y12
                        End If
                        If (sn = 3) Then
                            x1 = x13
                            y1 = y13
                        End If

                        If (sn = 4) Then
                            x1 = x14
                            y1 = y14
                        End If

                        If (sn = 5) Then
                            x1 = x15
                            y1 = y15
                        End If

                        If (sn = 6) Then
                            x1 = x16
                            y1 = y16
                        End If

                        If (sn = 7) Then
                            x1 = x17
                            y1 = y17
                        End If

                        If (sn = 8) Then
                            x1 = x18
                            y1 = y18
                        End If

                        If (sn = 9) Then
                            x1 = x19
                            y1 = y19
                        End If
                        orto = x1
                        y99 = y1
          End Function
 
           Sub Macro3()
 
                  Dim s(60)
 
                        z1 = "05031944"
                        z1 = Replace(z1, "0", "") '
                        z2 = ""         ' ""
                        z3 = ""  ' ""
                        z4 = ""     '  ""
                        zz = z1 + z2 + z3 + z4
                        nzz = Len(zz)
                        MsgBox "nzz = " & nzz
 
 
                        For m = 1 To nzz
                          si = Mid(zz, m, 1)
                          ' MsgBox "si = " & si
                          s(m) = KodBukva(si)
                          ' MsgBox "s(m) = " & s(m)
                         Next
 
 
 
                  Dim x(60)
                  Dim y(60)
 
 
                  For i = 1 To nzz
                      x(i) = orto(s(i), yi)
                      y(i) = yi
                  '    MsgBox "y{k} = " & y(k)
                  Next
 
                        Dim crvs5 As Curve
                        Set crvs5 = CreateCurve(ActiveDocument)
                        With crvs5.CreateSubPath(x(1), y(1))
                          For n = 2 To nzz
                          .AppendLineSegment x(n), y(n)
                        Next
                        .AppendLineSegment x(1), y(1)
                           .Closed = True
                        End With
                        Set s5 = ActiveLayer.CreateCurve(crvs5)
                        s5.Fill.UniformColor.RGBAssign 255, 0, 0
    End Sub

            Function KodBukva(ltr)
 
    If (ltr = "1") Then kod = 1
    If (ltr = "2") Then kod = 2
    If (ltr = "3") Then kod = 3
    If (ltr = "4") Then kod = 4
    If (ltr = "5") Then kod = 5
    If (ltr = "6") Then kod = 6
    If (ltr = "7") Then kod = 7
    If (ltr = "8") Then kod = 8
    If (ltr = "9") Then kod = 9
 
    If (ltr = "" Or ltr = "") Then kod = 1
    If (ltr = "" Or ltr = "") Then kod = 2
    If (ltr = "" Or ltr = "") Then kod = 3
    If (ltr = "" Or ltr = "") Then kod = 4
    If (ltr = "" Or ltr = "") Then kod = 5
    If (ltr = "" Or ltr = "") Then kod = 6
    If (ltr = "" Or ltr = "") Then kod = 7
    If (ltr = "" Or ltr = "") Then kod = 8
    If (ltr = "" Or ltr = "") Then kod = 9
 
    If (ltr = "" Or ltr = "") Then kod = 1
    If (ltr = "" Or ltr = "") Then kod = 2
    If (ltr = "" Or ltr = "") Then kod = 3
    If (ltr = "" Or ltr = "") Then kod = 4
    If (ltr = "" Or ltr = "") Then kod = 5
    If (ltr = "" Or ltr = "") Then kod = 6
    If (ltr = "" Or ltr = "") Then kod = 7
    If (ltr = "" Or ltr = "") Then kod = 8
    If (ltr = "" Or ltr = "") Then kod = 9
 
 
    If (ltr = "" Or ltr = "") Then kod = 1
    If (ltr = "" Or ltr = "") Then kod = 2
    If (ltr = "" Or ltr = "") Then kod = 3
    If (ltr = "" Or ltr = "") Then kod = 4
    If (ltr = "" Or ltr = "") Then kod = 5
    If (ltr = "" Or ltr = "") Then kod = 6
    If (ltr = "" Or ltr = "") Then kod = 7
    If (ltr = "" Or ltr = "") Then kod = 8
    If (ltr = "" Or ltr = "") Then kod = 9
 
    If (ltr = "" Or ltr = "") Then kod = 1
    If (ltr = "" Or ltr = "") Then kod = 2
    If (ltr = "" Or ltr = "") Then kod = 3
    If (ltr = "" Or ltr = "") Then kod = 4
    If (ltr = "" Or ltr = "") Then kod = 5
    If (ltr = "" Or ltr = "") Then kod = 6
 
    If (ltr = ".") Then kod = 1
    If (ltr = ",") Then kod = 2
    If (ltr = "!") Then kod = 3
    If (ltr = "?") Then kod = 4
    If (ltr = ";") Then kod = 5
    If (ltr = "~") Then kod = 6
    If (ltr = "*") Then kod = 7
    If (ltr = "|") Then kod = 8
    If (ltr = "/") Then kod = 9

KodBukva = kod
 
End Function