📄 linkages.frm
字号:
End Sub
Private Sub Command1_Click() '按钮的动作
shuju
End
End Sub
Private Sub Command3_Click()
l0:
Dim i, aa, bb As Long
'If Me.Text9.Text < 10 Then
' Me.Text9.Text = 10
' MsgBox ("为了避免过多的数据导致数据库过大，我们取步进精度为10度！")
'End If
Me.getvalue
i = 1
Do While i < num + 2
linkages.BJ = 3.14159265358979 / 18
jisuan
'Sql = "delete from tempdata where id=2" 'SQL查询语句
Sql = "select top 1 * from tempdata Order By id asc"
Set rs = New ADODB.Recordset '新建一个实例
rs.Open Sql, conn, 2, 2
If bb = 0 Then '第二个点将不再判断
If Not rs.EOF Then
aa = rs("id")
End If
bb = 1
If aa > 0 Then GoTo l1 '数据库有数据
End If
rs.AddNew '增加一行记录
rs("id") = i
rs("cy1") = (Y1 / pi) * 180
rs("cxc") = XC '数据读写操作
rs("cyc") = YC
rs("xvc") = Vcx
rs("yvc") = Vcy
rs("xac") = Acx
rs("yac") = Acy
rs.Update '保存写入资料，如果使用只读权限，则不能使用这个方法
rs.Close
linkages.Y1 = linkages.Y1 + linkages.BJ '角度1＝初始角度＋步进角度
linkages.Y4 = linkages.Y4 - linkages.BJ * linkages.RAB
i = i + 1
Loop
' 添加输入的数据________________________________________________________________
mainmsg = "连杆AB长度：" & linkages.Text1.Text & "；连杆BC长度：" & linkages.Text2.Text & "；连杆CD的长度：" & linkages.Text3.Text & "；连架杆DE的长度：" & linkages.Text4.Text & "；机架AE的长度：" & linkages.Text5.Text & "；齿轮的传动比：" & linkages.Text6.Text & "；初始角θ：" & linkages.Text7.Text & "；初始角φ：" & linkages.Text8.Text
Sql = "select top 1 * from shuju "
Set rs = New ADODB.Recordset '新建一个实例
rs.Open Sql, conn, 2, 2
rs.AddNew '增加一行记录
rs("mm") = mainmsg
rs.Update
rs.Close
GoTo L2 '跳过清除数据
l1: Dim yn As Long '定义变量，看是否数据库还有数据
sql1 = "select top 1 * from tempdata ORDER BY id DESC "
Set rs = New ADODB.Recordset '新建一个实例
rs.Open sql1, conn, 2, 2
If Not rs.EOF Then
yn = rs("id") '返回当前行的值
End If
If yn > 1 Then
Dim UR As Integer
UR = MsgBox("数据库还有数据未清除，是否现在清除？", vbYesNo + vbQuestion + vbDefaultButton2, "提示.....")
Select Case UR
Case 6
i = 1
Do While i < yn + 1
Sql = "delete * from tempdata where id=" & i & " " 'SQL查询语句
'Sql = "select top 1 * from tempdata Order By id asc"
Set rs = New ADODB.Recordset '新建一个实例
rs.Open Sql, conn, 1, 3
i = i + 1
Loop
Sql = "delete * from shuju " 'SQL查询语句
Set rs = New ADODB.Recordset '新建一个实例
rs.Open Sql, conn, 1, 3
GoTo l0 '清空后重新添加
Case 7
'不清空的情况下直接显示窗口
DataReport2.Show '不清空则需要显示连杆的情况
GoTo l3
End Select
'设置全局变量为 false
End If
L2:
UR = MsgBox("是否显示数据库中保存连杆的情况？", vbYesNo + vbQuestion + vbDefaultButton2, "提示.....")
Select Case UR
Case 6
DataReport2.Show
Case 7
End Select
l3: DataReport1.Show
End Sub
Private Sub Command4_Click()
Call pduang
End Sub
Private Sub exit_Click()
shuju
End
End Sub
'子程序－－－－－－－计算的各个变量的值
Public Sub jisuan()
'建立各个参数的关系,最后所要求得的是c点的位置(xc,yc),c点的速度(vc),c点的加速度(ac)
'以下位置求解==================================================================================
' Y1 = Y1 + BJ '角度1＝初始角度＋步进角度
Dim a, b, c, d, e, f, A1, B1, C1, A2, B2, C2, H, i, j, k, M, n, P, Q, S As Double
XA = 0
YA = 0
XB = l1 * Cos(Y1)
YB = l1 * Sin(Y1)
XE = L5
YE = 0
XD = L5 + Cos(Y4) * l4
YD = Sin(Y4) * l4
H = l4 * Cos(Y4) + L5 - l1 * Cos(Y1)
i = l4 * Sin(Y4) - l1 * Sin(Y1)
A1 = 2 * H * L2
B1 = 2 * i * L2
C1 = l3 * l3 - H * H - i * i - L2 * L2
If Me.Option1 = True Then
Y2 = 2 * Atn((B1 + Sqr(A1 ^ 2 + B1 ^ 2 - C1 ^ 2)) / (A1 - C1))
ElseIf Me.Option2 = True Then
Y2 = 2 * Atn((B1 - Sqr(A1 ^ 2 + B1 ^ 2 - C1 ^ 2)) / (A1 - C1))
End If
j = 2 * i * l3
k = 2 * H * l3
M = H * H + i * i + l3 * l3 - L2 * L2
If Me.Option1 = True Then
Y3 = 2 * Atn((j + Sqr(j ^ 2 + k ^ 2 - M ^ 2)) / (k - M))
ElseIf Me.Option2 = True Then
Y3 = 2 * Atn((j - Sqr(j ^ 2 + k ^ 2 - M ^ 2)) / (k - M))
End If
XC = XB + L2 * Cos(Y2)
YC = YB + L2 * Sin(Y2)
XF = XB + l6 * Cos(Y2 + Y6)
YF = YB + l6 * Sin(Y2 + Y6)
'以下求速度===================================================================================
W1 = 1
W4 = -RAB * W1
n = l4 * W4 * Cos(Y4) - l1 * W1 * Cos(Y1)
P = l4 * W4 * Sin(Y4) - l1 * W1 * Sin(Y1)
W3 = (P * Cos(Y2) - n * Sin(Y2)) / (l3 * Cos(Y3) * Sin(Y2) - l3 * Sin(Y3) * Cos(Y2))
W2 = (n * Sin(Y3) - P * Cos(Y3)) / (L2 * Cos(Y2) * Sin(Y3) - L2 * Sin(Y2) * Cos(Y3))
VB = W1 * l1
Vbx = VB * Sin(Y1)
Vby = VB * Cos(Y1)
Vcx = Vbx - W2 * L2 * Sin(Y2)
Vcy = Vby + W2 * L2 * Cos(Y2)
Vfx = Vbx - W2 * l6 * Sin(Y2 + Y6)
Vfy = Vby + W2 * l6 * Cos(Y2 + Y6)
'以下求加速度================================================================================
A1 = 0
Ab = (W1 ^ 2) * l1
Abx = Ab * Cos(Y1)
Aby = -Ab * Sin(Y1)
A4 = 0
Q = l4 * A4 * Cos(Y4) - l4 * W4 ^ 2 * Sin(Y4) - l3 * W3 ^ 2 * Sin(Y3) + l1 * W1 ^ 2 * Sin(Y1) + L2 * W2 ^ 2 * Sin(Y2)
S = l3 * W3 ^ 2 * Cos(Y3) + l4 * A4 * Sin(Y4) + l4 * W4 ^ 2 * Cos(Y4) - l1 * W1 ^ 2 * Cos(Y1) - L2 * W2 ^ 2 * Cos(Y2)
A2 = (Q * Sin(Y3) - S * Cos(Y3)) / (L2 * Cos(Y2) * Sin(Y3) - L2 * Sin(Y2) * Cos(Y3))
A3 = (S * Cos(Y2) - Q * Sin(Y2)) / (l3 * Cos(Y3) * Sin(Y2) - l3 * Sin(Y3) * Cos(Y2))
Acx = Abx - A2 * L2 * Sin(Y2) - (W2 ^ 2) * L2 * Cos(Y2)
Acy = Aby + A2 * L2 * Cos(Y2) - (W2 ^ 2) * L2 * Sin(Y2)
Afx = Abx - A2 * l6 * Sin(Y2 + Y6) - (W2 ^ 2) * l6 * Cos(Y2 + Y6)
Afy = Aby + A2 * l6 * Cos(Y2 + Y6) - (W2 ^ 2) * l6 * Sin(Y2 + Y6)
'============================================================================================
End Sub
Public Sub getvalue()
l1 = Val(Text1.Text)
If l1 < 0 Then
MsgBox ("错误！杆长不能为负！")
Text1.Text = ""
End If
L2 = Val(Text2.Text)
If L2 < 0 Then
MsgBox ("错误！杆长不能为负！")
Text2.Text = ""
End If
l3 = Val(Text3.Text)
If l3 < 0 Then
MsgBox ("错误！杆长不能为负！")
Text3.Text = ""
End If
l4 = Val(Text4.Text)
If l4 < 0 Then
MsgBox ("错误！杆长不能为负！")
Text4.Text = ""
End If
L5 = Val(Text5.Text) '？？？？？？？？？？？
If L5 < 0 Then
MsgBox ("错误！杆长不能为负！")
Text5.Text = ""
End If
RAB = Val(Text6.Text)
'If RAB < 0 Then
'MsgBox ("错误！传动比为负不在我们的讨论区域内！")
'Me.Text6.Text = 1
'End If
Y1 = (Val(Text7.Text) / 180) * pi
Y4 = pi - (Val(Text8.Text) / 180) * pi
BJ = (Val(Text9.Text) / 180) * pi '将各个输入数赋予各个变量
If BJ < 0 Then
MsgBox ("步进精度不能小于0，系统将其值自动调整为1度！")
BJ = pi / 180
Text9.Text = 1
End If
num = Int(((Val(Text10.Text) * 2 * pi) / BJ)) ' 取整数即可。
l6 = Text11.Text
Y6 = (Text12.Text / 180) * pi
'***********************************************
End Sub
Public Sub shuju() '判断数据库是否有数据的程序，关闭时候
Dim yn As Long '定义变量，看是否数据库还有数据
sql1 = "select top 1 * from tempdata ORDER BY id DESC "
Set rs = New ADODB.Recordset '新建一个实例
rs.Open sql1, conn, 2, 2
If Not rs.EOF Then
yn = rs("id") '返回当前行的值
End If
If yn > 1 Then
Dim UR As Integer
UR = MsgBox("数据库还有数据未清除，是否现在清除？", vbYesNo + vbQuestion + vbDefaultButton2, "提示.....")
Select Case UR
Case 6
Dim i As Long
i = 1
Do While i < yn + 1
Sql = "delete * from tempdata where id=" & i & " " 'SQL查询语句
'Sql = "select top 1 * from tempdata Order By id asc"
Set rs = New ADODB.Recordset '新建一个实例
rs.Open Sql, conn, 1, 3
i = i + 1
Loop
Sql = "delete * from shuju " 'SQL查询语句
Set rs = New ADODB.Recordset '新建一个实例
rs.Open Sql, conn, 1, 3
MsgBox ("数据库清空！")
Case 7
End Select
'设置全局变量为 false
End If
End Sub
Public Sub pailei()
Dim temp As Double
temp = l1
If l1 > L2 Then
temp = l1
l1 = L2
L2 = temp
End If
If L2 > l3 Then
temp = L2
L2 = l3
l3 = temp
End If
If l3 > l4 Then
temp = l3
l3 = l4
l4 = temp
End If
If l4 > L5 Then
temp = l4
l4 = L5
L5 = temp
End If
temp = l1
If l1 > L2 Then
temp = l1
l1 = L2
L2 = temp
End If
If L2 > l3 Then
temp = L2
L2 = l3
l3 = temp
End If
If l3 > l4 Then
temp = l3
l3 = l4
l4 = temp
End If
temp = l1
If l1 > L2 Then
temp = l1
l1 = L2
L2 = temp
End If
If L2 > l3 Then
temp = L2
L2 = l3
l3 = temp
End If
temp = l1
If l1 > L2 Then
temp = l1
l1 = L2
L2 = temp
End If
End Sub
Private Sub new_Click()
Text1.Text = 0
Text2.Text = 0
Text3.Text = 0
Text4.Text = 0
Text5.Text = 0
Text6.Text = 0
Text7.Text = 0
Text8.Text = 0
Me.Command3.Enabled = False
End Sub
Private Sub Text1_Change()
Me.Command3.Enabled = False
End Sub
Private Sub Text10_Change()
temp11 = 0
End Sub
Private Sub Text2_Change()
Me.Command3.Enabled = False
End Sub
Private Sub Text3_Change()
Me.Command3.Enabled = False
End Sub
Private Sub Text4_Change()
Me.Command3.Enabled = False
End Sub
Private Sub Text5_Change()
Me.Command3.Enabled = False
End Sub
Private Sub Text6_Change()
Me.Command3.Enabled = False
End Sub
Private Sub Text7_Change()
Me.Command3.Enabled = False
End Sub
Private Sub Text8_Change()
Me.Command3.Enabled = False
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -