曲线坐标正反算VB源代码

Public Function HY() '计算第一缓和曲线

Dim W#, H#, Z26#, Z27#, Z28#, Z29#

W = Z - Z12 'li

If A < 0 Then

H = -1

Else

H = 1

End If

Z26 = (Z - Z12) ^ (2) / 2 / R / S * 180 / Pi 'β

Z27 = F + Z26 * H 'Ai

Z28 = W - W ^ (5) / 40 / R ^ (2) / S ^ (2) 'xi

Z29 = W ^ (3) / 6 / R / S 'yi

X = ZHX + Z28 * MCos(F) - H * Z29 * MSin(F) + P * MCos(Z27 + Q) '计算结果坐标X Y = ZHY + Z28 * MSin(F) + H * Z29 * MCos(F) + P * MSin(Z27 + Q) '计算结果坐标Y F1 = Z27 '切线方位角

End Function

Public Function YQ() '计算圆曲线

Dim K#, H#, Z32#, Z33#, Z34#, Z35#

K = Z - Z12

If A < 0 Then

H = -1

Else

H = 1

End If

Z32 = (K - 0.5 * S) / R * 180 / Pi 'β

Z33 = F + Z32 * H 'Ai

Z34 = R * MSin(Z32) + Z7 'xi

Z35 = R * (1 - MCos(Z32)) + Z5 'yi

X = ZHX + Z34 * MCos(F) - H * Z35 * MSin(F) + P * MCos(Z33 + Q) '计算结果坐标X Y = ZHY + Z34 * MSin(F) + H * Z35 * MCos(F) + P * MSin(Z33 + Q) '计算结果坐标Y F1 = Z33 '切线方位角

End Function

Public Function YH() '计算第二缓和曲线

Dim H#, M#, Z38#, Z39#, Z40#, Z41#, Z42#

If A > 0 Then

H = -1

Else

H = 1

End If

M = Z16 - Z 'li

Z42 = Z20 + 180

If Z42 > 360 Then

Z42 = Z42 - 360

End If

Z38 = M ^ (2) / 2 / R / T * 180 / Pi 'β

Z39 = Z20 + Z38 * H 'Ai

Z40 = M - M ^ (5) / 40 / R ^ (2) / T ^ (2) 'xi

Z41 = M ^ (3) / 6 / R / T 'yi

X = HZX + Z40 * MCos(Z42) - H * Z41 * MSin(Z42) + P * MCos(Z39 + Q) '计算结果坐标X

Y = HZY + Z40 * MSin(Z42) + H * Z41 * MCos(Z42) + P * MSin(Z39 + Q) '计算结果坐标Y

F1 = Z39 '切线方位角

End Function

Private Sub Command4_Click() '反算主程序

Dim F2#, F3#, F4#, XA#, YA#, PP#

If Trim(Text1.T ext) = "" Then MsgBox "请输入“本交点坐标X”！", vbInformation, "提示": T ext1.SetFocus: Exit Sub '若数值为空则进行提示！

If Trim(Text2.T ext) = "" Then MsgBox "请输入“本交点坐标Y”！", vbInformation, "提示": T ext2.SetFocus: Exit Sub

If Trim(Text3.T ext) = "" Then MsgBox "请输入“交点桩号JD”！", vbInformation, "提示": T ext3.SetFocus: Exit Sub

If Trim(Text4.T ext) = "" Or Trim(Text4.T ext) = 0 Then MsgBox "请输入”曲线半径R”！

", vbInformation, "提示": Text4.SetFocus: Exit Sub

If Trim(Text5.T ext) = "" Then MsgBox "请输入“第一缓和曲线长Ls1”！", vbInformation, "提示": T ext5.SetFocus: Exit Sub

If Trim(Text6.T ext) = "" Then MsgBox "请输入“第二缓和曲线长Ls2”！", vbInformation, "提示": T ext6.SetFocus: Exit Sub

If Trim(Text7.T ext) = "" Or Trim(Text7.T ext) = 0 Then MsgBox "请输入“曲线转角α”左负-，右正+！", vbInformation, "提示": T ext7.SetFocus: Exit Sub

If Trim(Text8.T ext) = "" Then MsgBox "请输入“计算方位角F”d.ms格式！", vbInformation, "提示": T ext8.SetFocus: Exit Sub

If Trim(Text47.T ext) = "" Then MsgBox "请输入“反算坐标X”！", vbInformation, "提示": T ext47.SetFocus: Exit Sub

If Trim(Text48.T ext) = "" Then MsgBox "请输入“反算坐标Y”！", vbInformation, "提示": T ext48.SetFocus: Exit Sub

Call SJ '调用子程序

Call YS

XA = Text47.T ext: YA = Text48.T ext

Z = Z14: P = 0: Q = 0

Lbl1:

If Z <= Z12 Then

Call ZX1

ElseIf Z <= Z13 Then

Call HY

ElseIf Z <= Z15 Then

Call YQ

ElseIf Z <= Z16 Then

Call YH

ElseIf Z >= Z16 Then

Call ZX2

End If

F2 = F1 - 90

F3 = (YA - Y) * MCos(F2) - (XA - X) * MSin(F2)

If Abs(F3) > 0.0001 Then

Z = Z + F3

GoTo Lbl1

Else

GoTo JG

End If

JG:

F4 = (Y - YA) / MSin(F2)

Label80.Caption = Format(Z, "00+000.000") 'Format为显示格式函数Label81.Caption = Round(F4, 3)

End Sub