求机械优化设计0.618法,变量轮换法,牛顿法VB语言程序
发布网友
发布时间:2022-05-29 22:23
我来回答
共1个回答
热心网友
时间:2024-12-04 20:11
0.618法,我不太清楚了,我这里有个牛顿迭代发的原代码,你看可以不吗,我记得这个好象是机械优化设计上的Public Function 弧转角(temp As Double) As Double
Dim pi As Double
pi = 4 * Atn(1#)
弧转角 = temp * 180 / pi
End Function
Public Function 精度*(k2 As Double, k1 As Double) As Integer
Dim temp As Double
temp = Abs(k2 - k1) / (1 + Abs(k2)) - 0.00000001
If temp < 0 Then
精度* = 1
Else
精度* = 0
End If
End Function
'Public Function getarf(myarf As Double) As Double
' Dim a As Double
' a = Val(Text1)
' getarf = myarf - (Tan(myarf) - myarf - a) / (Tan(myarf) * Tan(myarf))
'End Function
Public Function 开3次方(temp As Double) As Double
Dim pi As Double
开3次方 = Exp(Log(temp) / 3)
End Function
Private Sub Command1_Click()
Dim pi As Double
Dim m As Double
Dim z As Integer
Dim ap As Double
Dim ap1 As Double
Dim s As Double
Dim dlx As Double
Dim d As Double
Dim d0 As Double
Dim inva As Double
Dim invae As Double
Dim ae As Double
Dim ae1 As Double
Dim dx As Double
Dim mo As Double
Dim mj As Double
Dim sg As Double
Dim xg As Double
Dim dl As Double
Dim wf As Double
Dim tf As Double
Dim sf As Double
Dim a1 As Double
Dim b As Double
Dim b1 As Double
Dim invae1 As Double
Dim w As Double
Dim i As Integer
Dim n As Integer
Dim arf0 As Double
Dim arf1 As Double
Dim arf2 As Double
Dim a As Double
pi = 3.141592654
m = Val(Text1)
z = Val(Text2)
ap = Val(Text3)
s = Val(Text4)
sg = Val(Text5)
xg = Val(Text6)
dlx = Val(Text7)
If m <> 0 Then
If z <> 0 Then
If ap <> 0 Then
If s <> 0 Then
If dlx <> 0 Then
d = m * z
ap1 = pi / 180 * ap
d0 = d * Cos(ap1)
inva = Tan(ap1) - ap1
tf = pi * m
sf = pi * m / 2
wf = 57.29578 * ((tf - sf) / d)
dl = d * Sin(wf * pi / 180) / Cos(ap1 + wf * pi / 180)
invae = s / d + inva + dlx / d0 - pi / z
'ae = Atn(1.442252453 * invae ^ (1 / 3) + 0.599931525 * invae + 0.1093716057 * invae ^ 1.67 - 0.01932924212 * invae ^ 2.26)
a = invae
arf0 = 开3次方(a * 3)
arf2 = arf0 - (Tan(arf0) - arf0 - a) / (Tan(arf0) * Tan(arf0))
Do
arf1 = arf2
arf2 = arf2 - (Tan(arf2) - arf2 - a) / (Tan(arf2) * Tan(arf2))
Loop Until 精度*(arf2, arf1) = 1
ae = arf2
ae1 = ae * 180 / pi
dx = Sqr((d0 * Tan(ae) - dlx) ^ 2 + d0 ^ 2)
If z Mod 2 = 0 Then
mo = d0 / Cos(ae) + dlx
Text8 = ""
Text9 = ""
Text0 = ""
Text11 = ""
Text12 = ""
Text13 = ""
Text14 = ""
Text15 = ""
Text14 = Format(mo, "0.0000")
Else
mj = (d0 / Cos(ae)) * Cos((90 / z) * pi / 180) + dlx
Text8 = ""
Text9 = ""
Text0 = ""
Text11 = ""
Text12 = ""
Text13 = ""
Text14 = ""
Text15 = ""
Text15 = Format(mj, "0.0000")
End If
Text8 = Format(d, "0.000000000000000")
Text9 = Format(d0, "0.000000000000000")
Text10 = Format(inva, "0.000000000000000")
Text11 = Format(invae, "0.000000000000000")
Text12 = Format(ae1, "0.000000000000000")
Text13 = Format(dx, "0.000000000000000")
Else
MsgBox "请输入数据并保证输入正确", vbInformation, "信息"
End If
Else
MsgBox "请输入数据并保证输入正确", vbInformation, "信息"
End If
Else
MsgBox "请输入数据并保证输入正确", vbInformation, "信息"
End If
Else
MsgBox "请输入数据并保证输入正确", vbInformation, "信息"
End If
Else
MsgBox "请输入数据并保证输入正确", vbInformation, "信息"
End If
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub Command3_Click()
Dim pi As Double
Dim m As Double
Dim z As Integer
Dim ap As Double
Dim ap1 As Double
Dim ax As Double
Dim s As Double
Dim dlx As Double
Dim d As Double
Dim d0 As Double
Dim inva As Double
Dim invae As Double
Dim ae As Double
Dim ae1 As Double
Dim dx As Double
Dim mo As Double
Dim mj As Double
Dim sg As Double
Dim xg As Double
Dim dl As Double
Dim wf As Double
Dim tf As Double
Dim sf As Double
Dim a1 As Double
Dim b As Double
Dim b1 As Double
Dim invax As Double
Dim w As Double
Dim wx As Double
Dim i As Integer
Dim n As Integer
Dim arf0 As Double
Dim arf1 As Double
Dim arf2 As Double
Dim a As Double
pi = 3.141592654
m = Val(Text16)
z = Val(Text17)
ap = Val(Text18)
dx = Val(Text19)
If m <> 0 Then
If z <> 0 Then
If ap <> 0 Then
If dx <> 0 Then
d = m * z
ap1 = pi / 180 * ap
d0 = d * Cos(ap1)
inva = Tan(ap1) - ap1
tf = pi * m
sf = pi * m / 2
wf = 57.29578 * ((tf - sf) / d)
dl = d * Sin(wf * pi / 180) / Cos(ap1 + wf * pi / 180)
ax = Atn(Sqr(dx ^ 2 - d0 ^ 2) / d0)
invax = Tan(ax) - ax
s = dx * (sf / d + inva - invax)
wx = 57.29578 * (pi / z - s / dx) * pi / 180
dlx = dx * Sin(wx) / Cos(ax + wx)
invae = s / d + inva + dlx / d0 - pi / z
'ae = Atn(1.442252453 * invae ^ (1 / 3) + 0.599931525 * invae + 0.1093716057 * invae ^ 1.67 - 0.01932924212 * invae ^ 2.26)
a = invae
arf0 = 开3次方(a * 3)
arf2 = arf0 - (Tan(arf0) - arf0 - a) / (Tan(arf0) * Tan(arf0))
Do
arf1 = arf2
arf2 = arf2 - (Tan(arf2) - arf2 - a) / (Tan(arf2) * Tan(arf2))
Loop Until 精度*(arf2, arf1) = 1
ae = arf2
ae1 = ae * 180 / pi
If z Mod 2 = 0 Then
mo = d0 / Cos(ae) + dlx
Text20 = ""
Text21 = ""
Text22 = ""
Text23 = ""
Text24 = ""
Text25 = ""
Text26 = ""
Text27 = ""
Text28 = ""
Text27 = Format(mo, "0.0000")
Else
mj = (d0 / Cos(ae)) * Cos((90 / z) * pi / 180) + dlx
Text20 = ""
Text21 = ""
Text22 = ""
Text23 = ""
Text24 = ""
Text25 = ""
Text26 = ""
Text27 = ""
Text28 = ""
Text28 = Format(mj, "0.0000")
End If
Text20 = Format(d, "0.000000000000")
Text21 = Format(d0, "0.000000000000")
Text22 = Format(inva, "0.000000000000")
Text23 = Format(ax * 180 / pi, "0.000000000000")
Text24 = Format(s, "0.000000000000")
Text25 = Format(wx * 180 / pi, "0.000000000000")
Text26 = Format(dlx, "0.000000000000")
Text27 = Format(ae1, "0.000000000000")
Else
MsgBox "请输入模数m数据并保证输入正确", vbInformation, "信息"
End If
Else
MsgBox "请输入齿数z数据并保证输入正确", vbInformation, "信息"
End If
Else
MsgBox "请输入压力角ap数据并保证输入正确", vbInformation, "信息"
End If
Else
MsgBox "请输入接触圆直径dx数据并保证输入正确", vbInformation, "信息"
End If
End Sub