Текст программы формы определения зон действия механизма

Dim k As Byte

Private Sub Form_Click()

Unload Me

End Sub

Private Sub Form_Load()

FormZona.Height = 7095

Set Obj = FormZona

End Sub

Private Sub MenuZona1_Click()

Cls

fl = 0

fl2 = 1

Zonazv

End Sub

Private Sub MenuZona2_Click()

Cls

fl = 0

fl2 = 2

Zonazv

End Sub

Private Sub MenuZona3_Click()

Cls

fl = 0

fl2 = 3

Zonazv

End Sub

Private Sub MenuZonaEnd_Click()

Unload Me

End Sub

Private Sub MenuZonaVsego_Click()

Cls

fl = 1

Zonazv

End Sub

Rem определение зоны действия звеньев механизма

Private Sub Zonazv()

Dim rx As Integer, ry As Integer

Dim i As Integer, j As Integer, DrawStile As Integer

Dim maxx0 As Single, minx0 As Single

Dim maxy0 As Single, miny0 As Single

VvodDannych

ry = 380: rx = 1.6 * ry

Scale (0, ry)-(rx, 0)

Dim xa(100, 5) As Single, ya(100, 5) As Single

Dim maxx(5) As Single, maxy(5) As Single

Dim minx(5) As Single, miny(5) As Single

fi = 0

Raschet

For i = 1 To 5

If i = 5 Then X(i) = X(i) + l(5)

maxx(i) = X(i): maxy(i) = Y(i)

minx(i) = X(i): miny(i) = Y(i)

Next i

i = 0: dx = 0.3

For fi = 0 To pi2 Step dx

Raschet

i = i + 1

For j = 1 To 5

xa(i, j) = X(j)

ya(i, j) = Y(j)

If xa(i, j) > maxx(j) Then maxx(j) = xa(i, j)

If xa(i, j) < minx(j) Then minx(j) = xa(i, j)

If ya(i, j) > maxy(j) Then maxy(j) = ya(i, j)

If ya(i, j) < miny(j) Then miny(j) = ya(i, j)

Next j

Next fi

If fl = 1 Then GoTo Zona2

Select Case fl2

Case 1

DrawStile = 2

Line (minx(2), maxy(2))-(maxx(2), miny(2)), QBColor(2), B

Case 2

DrawStile = 4

Line (minx(2), maxy(4) + 15)-(maxx(2), miny(2)), QBColor(3), B

Case 3

DrawStile = 5

Line (minx(2), Y(5) + l(5))-(maxx(3), miny(2)), QBColor(5), B

End Select

GoTo Zona1

Zona2:

maxx0 = maxx(1): maxy0 = maxy(1)

minx0 = minx(1): miny0 = miny(1)

For j = 1 To 5

If maxx(j) > maxx0 Then maxx0 = maxx(j)

If maxy(j) > maxy0 Then maxy0 = maxy(j)

If minx(j) < minx0 Then minx0 = minx(j)

If miny(j) < miny0 Then miny0 = miny(j)

Next j

DrawStile = 3

Line (minx0, maxy0 + 15)-(maxx0, miny0), QBColor(4), B

Zona1:

k = 0

Ft = Val(TextZonaNach.Text)

fi = Ft / 180 * pi

Raschet

Postroenie

Psopor

k = 1

Ft = Val(TextZonaCon.Text)

fi = Ft / 180 * pi

Raschet

Postroenie

Psopor

Erase xa, ya

fl = 0

End Sub

Текст программы формы демонстрации траектории заданной точки

Dim tc(5, 5) As Integer, XT(10) As Integer

Dim tc1(6, 6) As String, Ft As Integer

Private Sub Form_Load()

Rem таблица связей

Set Obj = FormTrec

VvodDannych

tc1(1, 1) = "Точка": tc1(1, 2) = "1": tc1(1, 3) = "2"

tc1(1, 4) = "3": tc1(1, 5) = "4": tc1(1, 6) = "5"

tc1(2, 1) = "O (1)": tc1(3, 1) = "A (2)": tc1(4, 1) = "B (3)":

tc1(5, 1) = "D (4)": tc1(6, 1) = "C (5)"

tc(1, 2) = 1: tc(2, 3) = 1: tc(2, 4) = 1: tc(3, 5) = 1

tc(2, 1) = 1: tc(3, 2) = 1: tc(4, 2) = 1: tc(5, 3) = 1

Ft = 30

End Sub

Private Sub ComTrecRis_Click()

Dim rx As Integer, ry As Integer

Traectorij

If CheckTrec.Value = Checked Then

ry = 380: rx = 1.6 * ry

Scale (0, ry)-(rx, 0)

fi = Ft / 180 * pi

Raschet

Postroenie

Psopor

Else

Exit Sub

End If

End Sub

Private Sub ComTrec2_Click()

Unload Me

End Sub

Private Sub ComTrec1_Click()

Dim rx As Integer, ry As Integer

ry = 380: rx = 1.6 * ry

Scale (0, ry)-(rx, 0)

Traectorij

Traectorij1

End Sub

Rem построение траектории движения точки

Private Sub Traectorij()

Dim i As Integer, j As Integer, k As Integer

Cls

MSFlexGridTrec.ColWidth(0) = 1000

k = (MSFlexGridTrec.Width - 1000) / 5

MSFlexGridTrec.ColAlignment(0) = 2

For i = 1 To 5

MSFlexGridTrec.ColAlignment(i) = 2

MSFlexGridTrec.ColWidth(i) = k

Next i

' CurrentX = 50: CurrentY = 10

For i = 1 To 6

MSFlexGridTrec.Col = i - 1

MSFlexGridTrec.Row = 0

MSFlexGridTrec.Text = tc1(1, i)

'Print MSFlexGridTrec.Text

Next i

For i = 2 To 6

MSFlexGridTrec.Col = 0

MSFlexGridTrec.Row = i - 1

MSFlexGridTrec.Text = tc1(i, 1)

'Print MSFlexGridTrec.Text

Next i

For i = 1 To 5

For j = 1 To 5

MSFlexGridTrec.Col = i

MSFlexGridTrec.Row = j

MSFlexGridTrec.Text = Str$(tc(i, j))

'Print MSFlexGridTrec.Text

Next j

Next i

End Sub

Rem построение траектории движения точки

Private Sub Traectorij1()

Dim f1 As Single, f2 As Single, i As Integer, j As Integer

Dim n2 As Integer, n3 As Integer, n1 As Integer

Dim x1 As Single, y1 As Single

dx = 0.3

fi = Val(TextTrecUgol1.Text) / 180 * pi

f1 = fi

Raschet

Postroenie

Psopor

traekt1:

If TextTrec1.Text = "" Or TextTrec2.Text = "" _

Or TextTrec3.Text = "" Then

DoEvents

GoTo traekt1

End If

n1 = Val(TextTrec1.Text)

n2 = Val(TextTrec2.Text)

n3 = Val(TextTrec3.Text)

If n1 > 5 Or n2 > 5 Or n1 = 0 Or n2 = 0 Then

MsgBox "НЕT ТАКОЙ ТОЧКИ", , "Траектория"

TextTrec1.Text = ""

TextTrec2.Text = ""

TextTrec3.Text = ""

GoTo traekt1

End If

For i = 1 To 5

For j = 1 To 5

If tc(n1, n2) = 0 Then

MsgBox "НЕT СВЯЗИ МЕЖДУ ТОЧКАМИ", , "Траектория"

TextTrec1.Text = ""

TextTrec2.Text = ""

TextTrec3.Text = ""

GoTo traekt1

End If

Next j

Next i

fi = Val(TextTrecUgol2.Text) / 180 * pi

f2 = fi

Raschet

Postroenie

Psopor

'DoEvents

For fi = f1 To f2 Step dx / 4

Raschet

x1 = X(n1) + n3 / 100 * (X(n2) - X(n1))

y1 = Y(n1) + n3 / 100 * (Y(n2) - Y(n1))

If fi = f1 Then

CurrentX = x1 + 10: CurrentY = y1 + 5

Print "F"

End If

Circle (x1, y1), 3, QBColor(12)

Next fi

End Sub