vb过程太大,高手们能否简化此程序,希望高手帮忙,万分感激
时间:2011-11-25
来源:互联网
Private Sub 坐标系1(轴长, 最大值, 弯矩最大处)
Pic1.Scale (-轴长 / 5, 最大值 * 2)-(轴长 * 1.4, -(最大值 * 2))
Pic1.Line (0, -(最大值 * 1.5))-(0, 最大值 * 1.5)
Pic1.Line -(-轴长 / 100, 最大值 * 1.3), vbBlue
Pic1.Line (轴长 / 100, 最大值 * 1.3)-(0, 最大值 * 1.5), vbBlue
Pic1.Line (0, 0)-(轴长 * 1.25, 0)
Pic1.Line -(轴长 * 1.22, 最大值 / 16), vbBlue
Pic1.Line (轴长 * 1.22, -最大值 / 16)-(轴长 * 1.25, 0), vbBlue
Pic1.CurrentX = -轴长 / 100
Pic1.CurrentY = 0
Pic1.Print 0
Pic1.CurrentX = 轴长
Pic1.CurrentY = 0
Pic1.Print 轴长
Pic1.CurrentX = 弯矩最大处
Pic1.CurrentY = 0
Pic1.Print 弯矩最大处
Pic1.CurrentX = 轴长 * 1.25
Pic1.CurrentY = 0
Pic1.Print "X"
Pic1.CurrentX = 轴长 / 50
Pic1.CurrentY = 最大值 * 1.5
Pic1.Print "Y"
Pic1.CurrentX = 弯矩最大处 * 0.99
Pic1.CurrentY = 最大值 * 1.32
Pic1.Print Round(最大值)
'Pic1.Circle (弯矩最大处, 最大值), 0.1, vbRed
End Sub
Private Sub 坐标系2(轴长, 最小值, 弯矩最小处)
Pic1.Scale (-轴长 / 5, Abs(最小值) * 2)-(轴长 * 1.4, -(Abs(最小值) * 2))
Pic1.Line (0, -(Abs(最小值) * 1.5))-(0, Abs(最小值) * 1.5)
Pic1.Line -(-轴长 / 100, Abs(最小值) * 1.3), vbBlue
Pic1.Line (轴长 / 100, Abs(最小值) * 1.3)-(0, Abs(最小值) * 1.5), vbBlue
Pic1.Line (0, 0)-(轴长 * 1.25, 0)
Pic1.Line -(轴长 * 1.22, Abs(最小值) / 16), vbBlue
Pic1.Line (轴长 * 1.22, Abs(最小值) / 16)-(轴长 * 1.25, 0), vbBlue
Pic1.CurrentX = -轴长 / 100
Pic1.CurrentY = 0
Pic1.Print 0
Pic1.CurrentX = 轴长
Pic1.CurrentY = 0
Pic1.Print 轴长
Pic1.CurrentX = 弯矩最小处
Pic1.CurrentY = 0
Pic1.Print 弯矩最小处
Pic1.CurrentX = 轴长 * 1.25
Pic1.CurrentY = 0
Pic1.Print "X"
Pic1.CurrentX = 轴长 / 50
Pic1.CurrentY = 最小值 * 1.5
Pic1.Print "Y"
Pic1.CurrentX = 弯矩最小处 * 0.99
Pic1.CurrentY = 最小值 * 1.32
Pic1.Print Round(最小值)
'Pic1.Circle (弯矩最大处, 最大值), 0.1, vbRed
End Sub
Private Sub 坐标系3(轴长, 最大值, 弯矩最大处)
Pic2.Scale (-轴长 / 5, 最大值 * 2)-(轴长 * 1.4, -(最大值 * 2))
Pic2.Line (0, -(最大值 * 1.5))-(0, 最大值 * 1.5)
Pic2.Line -(-轴长 / 100, 最大值 * 1.3), vbBlue
Pic2.Line (轴长 / 100, 最大值 * 1.3)-(0, 最大值 * 1.5), vbBlue
Pic2.Line (0, 0)-(轴长 * 1.25, 0)
Pic2.Line -(轴长 * 1.22, 最大值 / 16), vbBlue
Pic2.Line (轴长 * 1.22, -最大值 / 16)-(轴长 * 1.25, 0), vbBlue
Pic2.CurrentX = -轴长 / 100
Pic2.CurrentY = 0
Pic2.Print 0
Pic2.CurrentX = 轴长
Pic2.CurrentY = 0
Pic2.Print 轴长
Pic2.CurrentX = 弯矩最大处
Pic2.CurrentY = 0
Pic2.Print 弯矩最大处
Pic2.CurrentX = 轴长 * 1.25
Pic2.CurrentY = 0
Pic2.Print "X"
Pic2.CurrentX = 轴长 / 50
Pic2.CurrentY = 最大值 * 1.5
Pic2.Print "Y"
Pic2.CurrentX = 弯矩最大处 * 0.99
Pic2.CurrentY = 最大值 * 1.32
Pic2.Print Round(最大值)
End Sub
Private Sub 坐标系4(轴长, 最小值, 弯矩最小处)
Pic2.Scale (-轴长 / 5, Abs(最小值) * 2)-(轴长 * 1.4, -(Abs(最小值) * 2))
Pic2.Line (0, -(Abs(最小值) * 1.5))-(0, Abs(最小值) * 1.5)
Pic2.Line -(-轴长 / 100, Abs(最小值) * 1.3), vbBlue
Pic2.Line (轴长 / 100, Abs(最小值) * 1.3)-(0, Abs(最小值) * 1.5), vbBlue
Pic2.Line (0, 0)-(轴长 * 1.25, 0)
Pic2.Line -(轴长 * 1.22, Abs(最小值) / 16), vbBlue
Pic2.Line (轴长 * 1.22, Abs(最小值) / 16)-(轴长 * 1.25, 0), vbBlue
Pic2.CurrentX = -轴长 / 100
Pic2.CurrentY = 0
Pic2.Print 0
Pic2.CurrentX = 轴长
Pic2.CurrentY = 0
Pic2.Print 轴长
Pic2.CurrentX = 弯矩最小处
Pic2.CurrentY = 0
Pic2.Print 弯矩最小处
Pic2.CurrentX = 轴长 * 1.25
Pic2.CurrentY = 0
Pic2.Print "X"
Pic2.CurrentX = 轴长 / 50
Pic2.CurrentY = 最小值 * 1.5
Pic2.Print "Y"
Pic2.CurrentX = 弯矩最小处 * 0.99
Pic2.CurrentY = 最小值 * 1.32
Pic2.Print Round(最小值)
End Sub
Private Function Fp11(l, xp1, p1, x)
Fp11 = (1 - xp1 / l) * p1
End Function
Private Function Fp12(l, xp1, p1, x)
Fp12 = -xp1 * p1 / l
End Function
Private Function Mp11(l, xp1, p1, x)
Mp11 = (1 - xp1 / l) * p1 * x
End Function
Private Function Mp12(l, xp1, p1, x)
Mp12 = (1 - xp1 / l) * p1 * x - p1 * (x - xp1)
End Function
Private Sub Command2_Click()
Pic1.Cls
Dim y()
l = Val(Text3.Text)
ReDim y(l * 1000)
Max = 0
Maxx = 0
Min = 0
Minx1 = 0
If Combo1.Text = "简支梁" Then
If Val(Text1.Text) = 1 Then
If Val(Text2.Text) = 0 And Val(Text11.Text) = 0 Then
p1 = Arr(1)
xp1 = Brr(1)
For i = 0 To l * 1000
x = i / 1000
If x < xp1 Then
y(i) = Mp11(l, xp1, p1, x)
Else
y(i) = Mp12(l, xp1, p1, x)
End If
If y(i) > Max Then
Max = y(i)
Maxx = x
End If
Next i
'frm扭转计算.Print Max
坐标系1 l, Max, Maxx '调用的上面的建坐标系的函数,很好
For i = 0 To l * 1000
x = i / 1000
Pic1.PSet (x, y(i))
If i Mod (50 * l) = 0 Then Pic1.Line (x, y(i))-(x, 0), vbBlack
Next i
Max = 0
Maxx = 0
Min = 0
Minx1 = 0
For i = 0 To l * 1000
x = i / 1000
Select Case x
Case Is <= xp1
y(i) = Fp11(l, xp1, p1, x)
Case Else
y(i) = Fp12(l, xp1, p1, x)
End Select
If y(i) > Max Then
Max = y(i)
Maxx = x
ElseIf y(i) < Min Then
Min = y(i)
Minx1 = x
End If
Next i
If Abs(Max) > Abs(Min) Then
坐标系3 l, Max, Maxx
Else
坐标系4 l, Min, Minx1
End If
For i = 0 To l * 1000
x = i / 1000
If i = 0 Then
Pic2.PSet (x, y(i))
Else
Pic2.Line (x, y(i))-(x - 1 / 1000, y(i - 1)), vbBlack
If i = l * 1000 Then Pic2.Line (x, y(i))-(x, 0), vbBlack
End If
If i Mod (50 * l) = 0 Then
Pic2.Line (x, y(i))-(x, 0), vbBlue
End If
Next i
End If
End If
End If
End Sub
Pic1.Scale (-轴长 / 5, 最大值 * 2)-(轴长 * 1.4, -(最大值 * 2))
Pic1.Line (0, -(最大值 * 1.5))-(0, 最大值 * 1.5)
Pic1.Line -(-轴长 / 100, 最大值 * 1.3), vbBlue
Pic1.Line (轴长 / 100, 最大值 * 1.3)-(0, 最大值 * 1.5), vbBlue
Pic1.Line (0, 0)-(轴长 * 1.25, 0)
Pic1.Line -(轴长 * 1.22, 最大值 / 16), vbBlue
Pic1.Line (轴长 * 1.22, -最大值 / 16)-(轴长 * 1.25, 0), vbBlue
Pic1.CurrentX = -轴长 / 100
Pic1.CurrentY = 0
Pic1.Print 0
Pic1.CurrentX = 轴长
Pic1.CurrentY = 0
Pic1.Print 轴长
Pic1.CurrentX = 弯矩最大处
Pic1.CurrentY = 0
Pic1.Print 弯矩最大处
Pic1.CurrentX = 轴长 * 1.25
Pic1.CurrentY = 0
Pic1.Print "X"
Pic1.CurrentX = 轴长 / 50
Pic1.CurrentY = 最大值 * 1.5
Pic1.Print "Y"
Pic1.CurrentX = 弯矩最大处 * 0.99
Pic1.CurrentY = 最大值 * 1.32
Pic1.Print Round(最大值)
'Pic1.Circle (弯矩最大处, 最大值), 0.1, vbRed
End Sub
Private Sub 坐标系2(轴长, 最小值, 弯矩最小处)
Pic1.Scale (-轴长 / 5, Abs(最小值) * 2)-(轴长 * 1.4, -(Abs(最小值) * 2))
Pic1.Line (0, -(Abs(最小值) * 1.5))-(0, Abs(最小值) * 1.5)
Pic1.Line -(-轴长 / 100, Abs(最小值) * 1.3), vbBlue
Pic1.Line (轴长 / 100, Abs(最小值) * 1.3)-(0, Abs(最小值) * 1.5), vbBlue
Pic1.Line (0, 0)-(轴长 * 1.25, 0)
Pic1.Line -(轴长 * 1.22, Abs(最小值) / 16), vbBlue
Pic1.Line (轴长 * 1.22, Abs(最小值) / 16)-(轴长 * 1.25, 0), vbBlue
Pic1.CurrentX = -轴长 / 100
Pic1.CurrentY = 0
Pic1.Print 0
Pic1.CurrentX = 轴长
Pic1.CurrentY = 0
Pic1.Print 轴长
Pic1.CurrentX = 弯矩最小处
Pic1.CurrentY = 0
Pic1.Print 弯矩最小处
Pic1.CurrentX = 轴长 * 1.25
Pic1.CurrentY = 0
Pic1.Print "X"
Pic1.CurrentX = 轴长 / 50
Pic1.CurrentY = 最小值 * 1.5
Pic1.Print "Y"
Pic1.CurrentX = 弯矩最小处 * 0.99
Pic1.CurrentY = 最小值 * 1.32
Pic1.Print Round(最小值)
'Pic1.Circle (弯矩最大处, 最大值), 0.1, vbRed
End Sub
Private Sub 坐标系3(轴长, 最大值, 弯矩最大处)
Pic2.Scale (-轴长 / 5, 最大值 * 2)-(轴长 * 1.4, -(最大值 * 2))
Pic2.Line (0, -(最大值 * 1.5))-(0, 最大值 * 1.5)
Pic2.Line -(-轴长 / 100, 最大值 * 1.3), vbBlue
Pic2.Line (轴长 / 100, 最大值 * 1.3)-(0, 最大值 * 1.5), vbBlue
Pic2.Line (0, 0)-(轴长 * 1.25, 0)
Pic2.Line -(轴长 * 1.22, 最大值 / 16), vbBlue
Pic2.Line (轴长 * 1.22, -最大值 / 16)-(轴长 * 1.25, 0), vbBlue
Pic2.CurrentX = -轴长 / 100
Pic2.CurrentY = 0
Pic2.Print 0
Pic2.CurrentX = 轴长
Pic2.CurrentY = 0
Pic2.Print 轴长
Pic2.CurrentX = 弯矩最大处
Pic2.CurrentY = 0
Pic2.Print 弯矩最大处
Pic2.CurrentX = 轴长 * 1.25
Pic2.CurrentY = 0
Pic2.Print "X"
Pic2.CurrentX = 轴长 / 50
Pic2.CurrentY = 最大值 * 1.5
Pic2.Print "Y"
Pic2.CurrentX = 弯矩最大处 * 0.99
Pic2.CurrentY = 最大值 * 1.32
Pic2.Print Round(最大值)
End Sub
Private Sub 坐标系4(轴长, 最小值, 弯矩最小处)
Pic2.Scale (-轴长 / 5, Abs(最小值) * 2)-(轴长 * 1.4, -(Abs(最小值) * 2))
Pic2.Line (0, -(Abs(最小值) * 1.5))-(0, Abs(最小值) * 1.5)
Pic2.Line -(-轴长 / 100, Abs(最小值) * 1.3), vbBlue
Pic2.Line (轴长 / 100, Abs(最小值) * 1.3)-(0, Abs(最小值) * 1.5), vbBlue
Pic2.Line (0, 0)-(轴长 * 1.25, 0)
Pic2.Line -(轴长 * 1.22, Abs(最小值) / 16), vbBlue
Pic2.Line (轴长 * 1.22, Abs(最小值) / 16)-(轴长 * 1.25, 0), vbBlue
Pic2.CurrentX = -轴长 / 100
Pic2.CurrentY = 0
Pic2.Print 0
Pic2.CurrentX = 轴长
Pic2.CurrentY = 0
Pic2.Print 轴长
Pic2.CurrentX = 弯矩最小处
Pic2.CurrentY = 0
Pic2.Print 弯矩最小处
Pic2.CurrentX = 轴长 * 1.25
Pic2.CurrentY = 0
Pic2.Print "X"
Pic2.CurrentX = 轴长 / 50
Pic2.CurrentY = 最小值 * 1.5
Pic2.Print "Y"
Pic2.CurrentX = 弯矩最小处 * 0.99
Pic2.CurrentY = 最小值 * 1.32
Pic2.Print Round(最小值)
End Sub
Private Function Fp11(l, xp1, p1, x)
Fp11 = (1 - xp1 / l) * p1
End Function
Private Function Fp12(l, xp1, p1, x)
Fp12 = -xp1 * p1 / l
End Function
Private Function Mp11(l, xp1, p1, x)
Mp11 = (1 - xp1 / l) * p1 * x
End Function
Private Function Mp12(l, xp1, p1, x)
Mp12 = (1 - xp1 / l) * p1 * x - p1 * (x - xp1)
End Function
Private Sub Command2_Click()
Pic1.Cls
Dim y()
l = Val(Text3.Text)
ReDim y(l * 1000)
Max = 0
Maxx = 0
Min = 0
Minx1 = 0
If Combo1.Text = "简支梁" Then
If Val(Text1.Text) = 1 Then
If Val(Text2.Text) = 0 And Val(Text11.Text) = 0 Then
p1 = Arr(1)
xp1 = Brr(1)
For i = 0 To l * 1000
x = i / 1000
If x < xp1 Then
y(i) = Mp11(l, xp1, p1, x)
Else
y(i) = Mp12(l, xp1, p1, x)
End If
If y(i) > Max Then
Max = y(i)
Maxx = x
End If
Next i
'frm扭转计算.Print Max
坐标系1 l, Max, Maxx '调用的上面的建坐标系的函数,很好
For i = 0 To l * 1000
x = i / 1000
Pic1.PSet (x, y(i))
If i Mod (50 * l) = 0 Then Pic1.Line (x, y(i))-(x, 0), vbBlack
Next i
Max = 0
Maxx = 0
Min = 0
Minx1 = 0
For i = 0 To l * 1000
x = i / 1000
Select Case x
Case Is <= xp1
y(i) = Fp11(l, xp1, p1, x)
Case Else
y(i) = Fp12(l, xp1, p1, x)
End Select
If y(i) > Max Then
Max = y(i)
Maxx = x
ElseIf y(i) < Min Then
Min = y(i)
Minx1 = x
End If
Next i
If Abs(Max) > Abs(Min) Then
坐标系3 l, Max, Maxx
Else
坐标系4 l, Min, Minx1
End If
For i = 0 To l * 1000
x = i / 1000
If i = 0 Then
Pic2.PSet (x, y(i))
Else
Pic2.Line (x, y(i))-(x - 1 / 1000, y(i - 1)), vbBlack
If i = l * 1000 Then Pic2.Line (x, y(i))-(x, 0), vbBlack
End If
If i Mod (50 * l) = 0 Then
Pic2.Line (x, y(i))-(x, 0), vbBlue
End If
Next i
End If
End If
End If
End Sub
作者: xiaoyuanaiai 发布时间: 2011-11-25

作者: yiguangqiang88 发布时间: 2011-11-25
引用 1 楼 yiguangqiang88 的回复:
看晕了,不看了……
看晕了,不看了……

作者: liuxingvcvc 发布时间: 2011-11-25
相关阅读 更多
热门阅读
-
office 2019专业增强版最新2021版激活秘钥/序列号/激活码推荐 附激活工具
阅读:74
-
如何安装mysql8.0
阅读:31
-
Word快速设置标题样式步骤详解
阅读:28
-
20+道必知必会的Vue面试题(附答案解析)
阅读:37
-
HTML如何制作表单
阅读:22
-
百词斩可以改天数吗?当然可以,4个步骤轻松修改天数!
阅读:31
-
ET文件格式和XLS格式文件之间如何转化?
阅读:24
-
react和vue的区别及优缺点是什么
阅读:121
-
支付宝人脸识别如何关闭?
阅读:21
-
腾讯微云怎么修改照片或视频备份路径?
阅读:28