Sub Macro1()

' При заданных 1-5 ограничениях найти мин/мах  ЦФ F = x + y
 
        ' Данные (отсекаемые отрезки по осям) ЦФ и областей ограничений
     a = 111
     b = 111
 
     a1 = 30   ' 1
     b1 = 20
 
     a2 = 15  ' 2
     b2 = 40
 
     a3 = 40  ' 3
     b3 = 5
 
     a4 = 100   ' 4
     b4 = 80
 
     a5 = 80   ' 5
     b5 = 95
 
     '  Начала системы координат
   Dim xc, yc, Ms

   '  размер поля:  7.2, 4.8, 454.8, 736.8)
   Ms = 0.05 ' масштаб чертежа
   xcc = 0 ' начала СК х
   ycc = 0 ' начала СК y
   ' Изображаем оси
   ' Dim s1 As Shape
 
    Dim s200 As Shape
    Dim crvs200 As Curve
    Set crvs200 = CreateCurve(ActiveDocument)
    With crvs200.CreateSubPath(0, 0)
        .AppendLineSegment 0, ycc
    End With
    Set s200 = ActiveLayer.CreateCurve(crvs200)
 
   ActiveLayer.CreateLineSegment 0, 0, 6, 0
   ActiveLayer.CreateLineSegment xcc, ycc, xcc, 6
   ActiveLayer.CreateArtisticText 6, ycc, "x"
   ActiveDocument.ClearSelection
   ActiveLayer.CreateArtisticText xcc, 6, "y"
   ActiveDocument.ClearSelection
 
    ' Изображаем ЦФ и ограничения в виде отрезков
    ActiveLayer.CreateLineSegment a * Ms, 0, 0, b * Ms
    ActiveLayer.CreateLineSegment a1 * Ms, 0, 0, b1 * Ms
    ActiveLayer.CreateLineSegment a2 * Ms, 0, 0, b2 * Ms
    ActiveLayer.CreateLineSegment a3 * Ms, 0, 0, b3 * Ms
    ActiveLayer.CreateLineSegment a4 * Ms, 0, 0, b4 * Ms
    ActiveLayer.CreateLineSegment a5 * Ms, 0, 0, b5 * Ms
 
    ' Обозначаем ЦФ и ограничения  точками на той или иной оси и номерами
        ActiveLayer.CreateArtisticText a * Ms, 0, "0"
        ActiveLayer.CreateArtisticText a1 * Ms, 0, "1"
        ActiveLayer.CreateArtisticText a2 * Ms, 0, "2"
        ActiveLayer.CreateArtisticText a3 * Ms, 0, "3"
        ActiveLayer.CreateArtisticText a4 * Ms, 0, "4"
        ActiveLayer.CreateArtisticText a5 * Ms, 0, "5"
    ' Ищем точки пересечения только на многограннике ограничений при x,y > 0
 
    PerOtrxyS a1, 0, 0, b1, a2, 0, 0, b2, x12, y12
    ActiveLayer.CreateArtisticText x12 * Ms, y12 * Ms, "12"
    PerOtrxyS a1, 0, 0, b1, a3, 0, 0, b3, x13, y13
    ActiveLayer.CreateArtisticText x13 * Ms, y13 * Ms, "13"
    PerOtrxyS a4, 0, 0, b4, a5, 0, 0, b5, x45, y45
    ActiveLayer.CreateArtisticText x45 * Ms, y45 * Ms, "12"
    Dim s50 As Shape
    Set s50 = ActiveLayer.CreateEllipse(x12 * Ms - 0.1, y12 * Ms - 0.1, x12 * Ms + 0.1, y12 * Ms + 0.1)
    s50.Fill.UniformColor.CMYKAssign 100, 255, 0, 0
    Set s50 = ActiveLayer.CreateEllipse(x13 * Ms - 0.1, y13 * Ms - 0.1, x13 * Ms + 0.1, y13 * Ms + 0.1)
    Set s50 = ActiveLayer.CreateEllipse(x45 * Ms - 0.1, y45 * Ms - 0.1, x45 * Ms + 0.1, y45 * Ms + 0.1)
    s50.Fill.UniformColor.CMYKAssign 255, 0, 0, 0
    ' Определяем точки и расстояние от точек пересечения до ЦФ
     PointPointSlineScript a, 0, 0, b, x12, y12, xc12, yc12
     ActiveLayer.CreateArtisticText xc12 * Ms, yc12 * Ms, "121"
     ActiveLayer.CreateLineSegment x12 * Ms, y12 * Ms, xc12 * Ms, yc12 * Ms
     ActiveLayer.CreateEllipse xc12 * Ms - 0.1, yc12 * Ms - 0.1, xc12 * Ms + 0.1, yc12 * Ms + 0.1
 
      PointPointSlineScript a, 0, 0, b, x13, y13, xc13, yc13
      ActiveLayer.CreateArtisticText xc13 * Ms, yc13 * Ms, "131"
      ActiveLayer.CreateEllipse xc13 * Ms - 0.1, yc13 * Ms - 0.1, xc13 * Ms + 0.1, yc13 * Ms + 0.1
      ActiveLayer.CreateLineSegment x13 * Ms, y13 * Ms, xc13 * Ms, yc13 * Ms
 
    PointPointSlineScript a, 0, 0, b, x45, y45, xc45, yc45
    ActiveLayer.CreateArtisticText xc45 * Ms, yc45 * Ms, "451"
    ActiveLayer.CreateLineSegment x45 * Ms, y45 * Ms, xc45 * Ms, yc45 * Ms
    Dim s51 As Shape
    Set s51 = ActiveLayer.CreateEllipse(xc45 * Ms - 0.1, yc45 * Ms - 0.1, xc45 * Ms + 0.1, yc45 * Ms + 0.1)
    ' s51.Fill.UniformColor.CMYKAssign 100, 100, 0, 0

 
    ' Вычисляем длины от точек пересечения до ЦФ
 
    s1 = Sqr((x12 - xc12) * (x12 - xc12) + (y12 - yc12) * (y12 - yc12))
    s2 = Sqr((x13 - xc13) * (x13 - xc13) + (y13 - yc13) * (y13 - yc13))
    s3 = Sqr((x45 - xc45) * (x45 - xc45) + (y45 - yc45) * (y45 - yc45))
    'MsgBox ("s1 = smax = " & s1)
    'MsgBox ("s2 = " & s2)
    'MsgBox ("s3 = smin = " & s3)
 
    ' Вычисляем знечения ЦФ  F = x + y
 
    MsgBox ("F1 = Fmin = " & x12 + y12)
    'MsgBox ("F2 = " & x13 + y13)
    MsgBox ("F3 = Fmax = " & x45 + y45)
End Sub
 

Function PerOtrxyS(x1, y1, x2, y2, x3, y3, x4, y4, x, y)
    Mash = 1 ' масштаб чертежа
    Ms = Mash * (730 / 297)
'    MsgBox ("x1 = " & x1)
    s11 = y4 - y3
    s12 = x3 - x4
    s13 = (x3 * y3 - x3 * y4) * 1 + (y3 * x4 - y3 * x3)
    s = (-s11 * x1 - s12 * y1 - s13) / (s11 * (x2 - x1) + s12 * (y2 - y1))
    x = (1 - s) * x1 * 1 + s * x2 * 1
    y = (1 - s) * y1 * 1 + s * y2 * 1
 
End Function
 
Function PointPointSlineScript(x1, y1, x2, y2, x3, y3, xd, yd)
 
     td = ((x2 - x1) * (x3 - x1) + (y2 - y1) * (y3 - y1)) / ((x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1))
 
     xd = (x2 - x1) * td * 1 + x1 * 1
     yd = (y2 - y1) * td * 1 + y1 * 1
 
End Function

Sub Macro2()
    '
    ' Recorded 07.04.2005
    '
    ' Description:
    '
    '
    Dim s200 As Shape
    Dim crvs200 As Curve
    Set crvs200 = CreateCurve(ActiveDocument)
    With crvs200.CreateSubPath(1.673386, 4.61622)
        .AppendLineSegment 5.008693, 8.306929
    End With
    Set s200 = ActiveLayer.CreateCurve(crvs200)
End Sub