VB编程中线细部点坐标计算程序设计

Question

用VB编写程序计算公路施工测量中线细部点坐标计算程序
有谁能帮我，程序要能够运行 ,急啊
谢谢了
本题要求按下述各种可能性进行程序设计，输出中线上各细部点及曲线主点的平面测设数据及里程：①、整标段为一直线；②、整标段仅有一组圆曲线；③、整标段仅有一组缓和曲线；④、整标段内由直线、圆曲线混合组成；⑤、整标段内由直线、圆曲线、缓和曲线混合组成。
输入数据时，应注意采取某种方法让程序自动识别：当前开始输入的中线设计数据是直线段数据，或者是圆曲线段数据，还是缓和曲线段数据，以便于程序计算模块进行准确处理。
输出数据应为整标段中线各细部点序号、里程及坐标。
注意：①、输出数据的输出顺序应为自一个标段的起点（里程值在该标段最小）开始，依次顺序至该标段的终点为止；②、输出数据中应包括如下各点数据：曲线上各特征点的点）的里程及坐标。

设计者应提交如下成果或资料：①、本课题的程序设计原理（应包括所使用的数学模型及具体设计方法，配有必要的图形、公式、表格）；②、本课题的程序功能介绍（尽可能按菜单进行详尽介绍）；③、程序使用说明书（应配有程序测试用的数据及其输出样例）；④、源程序。
VB程序编好后（*frm）文件发到邮箱：572619jwaim@163.com 谢谢，感激!!!
马上得用，感激!!!!!

Answer 1

那是“计算道路 中线 细部点 坐标计算程序”，是测绘专业语言。谢谢关注

Answer 2

Option Explicit
Dim Flag As Boolean, O As Double, X As Double, Y As Double, V As Double, W As Double
Dim Kjd() As Double, Lh() As Double, Njd() As Double, Ejd() As Double
Dim Ls1() As Double, Ls2() As Double, R() As Double, Th1() As Double, Th2() As Double
Dim JD As Long, m As Long
Dim i As Long, K As Double
Const Pi = 3.14159265358979

Private Sub Form_Load()
For X = 15 To 300 Step 5
For Y = 10 To 120 Step 5
Circle (X, Y), 5, RGB(230, 200, 170)
Next
Next
On Error GoTo ErrorHandler
Open "Data.txt" For Input As #1
Input #1, JD
ReDim Kjd(JD + 1), Njd(JD + 1), Ejd(JD + 1), R(JD), Ls1(JD), Ls2(JD), Th1(JD), Th2(JD), Lh(JD)
For i = 1 To JD
Input #1, Kjd(i), Njd(i), Ejd(i), R(i), Ls1(i), Ls2(i), Th1(i), Th2(i), Lh(i)
Next
Input #1, Kjd(0), Njd(0), Ejd(0), Kjd(i), Njd(i), Ejd(i)
Close #1
Exit Sub ' 退出子程序，以避免进入错误处理程序。
ErrorHandler: ' 错误处理程序。
MsgBox "找不到Data.txt文件或文件已损坏,程序即将关闭"
End
End Sub

Private Sub Label2_Click(Index As Integer)
反显主屏
反显次屏
Select Case Index
Case 0
Me.Caption = "推算坐标"
Case 1
Me.Caption = "反算桩号"
End Select
End Sub

Private Sub Label2_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Label2(0).ForeColor = &H404040
Label2(1).ForeColor = &H404040
Shape1.Top = Label2(Index).Top - 2
Label2(Index).ForeColor = &H55AAF
End Sub

Private Sub Label3_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Me.Caption = "反算桩号" Then Exit Sub
If Text1 <> Label3(Index) Then Flag = False
Text1 = Label3(Index)
Text1.Top = Label3(Index).Top
Text1.Left = Label3(Index).Left
Text1.ToolTipText = Label3(Index).ToolTipText
Shape1.Left = Label3(Index).Left - 2
Shape1.Top = Label3(Index).Top - 2
End Sub

Private Sub Label6_Click()
If Me.Caption = "推算坐标" Then
If Not IsNumeric(Label3(0)) Then Label3(0) = "桩号"
If Not IsNumeric(Label3(1)) Then Label3(1) = "边距"
If Not IsNumeric(Label3(2)) Then Label3(2) = "交角"
推算坐标
Else
If Not IsNumeric(Label7(0)) Then Label7(0) = "N坐标"
If Not IsNumeric(Label7(1)) Then Label7(1) = "E坐标"
反算桩号
End If
End Sub

Private Sub Label7_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Me.Caption = "推算坐标" Then Exit Sub
If Text1 <> Label7(Index) Then Flag = False
Text1 = Label7(Index)
Text1.Top = Label7(Index).Top
Text1.Left = Label7(Index).Left
Text1.ToolTipText = Label7(Index).ToolTipText
Shape1.Left = Label7(Index).Left - 2
Shape1.Top = Label7(Index).Top - 2
End Sub

Private Sub Label5_Click()
反显次屏
反显主屏
Me.Caption = "偏角法路线桩点计算"
End Sub

Private Sub Label5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text1.Top = -98
Shape1.Left = Label5.Left - 2
Shape1.Top = Label5.Top - 2
End Sub

Private Sub Label6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text1.Top = -98
Shape1.Left = Label6.Left - 2
Shape1.Top = Label6.Top - 2
End Sub

Sub 反显主屏()
Label1.Visible = Not Label1.Visible
Label2(0).Visible = Not Label2(0).Visible
Label2(1).Visible = Not Label2(1).Visible
End Sub

Sub 反显次屏()
Label4.Visible = Not Label4.Visible
Label3(0).Visible = Not Label3(0).Visible
Label3(1).Visible = Not Label3(1).Visible
Label3(2).Visible = Not Label3(2).Visible
Shape1.Top = Label3(0).Top - 2
Shape1.Left = Label3(0).Left - 2
Label5.Visible = Not Label5.Visible
Label6.Visible = Not Label6.Visible
Label7(0).Visible = Not Label7(0).Visible
Label7(1).Visible = Not Label7(1).Visible
End Sub

Private Sub Text1_Change()
If Flag = False Then Flag = True: Exit Sub
Select Case Text1.ToolTipText
Case "输入桩号"
Label3(0) = Trim(Text1)
Case "输入边距"
Label3(1) = Trim(Text1)
Case "输入交角"
Label3(2) = Trim(Text1)
Case "输入N坐标"
Label7(0) = Trim(Text1)
Case "输入E坐标"
Label7(1) = Trim(Text1)
End Select
If Me.Caption = "推算坐标" Then
Label7(0) = "N坐标"
Label7(1) = "E坐标"
Else
Label3(0) = "桩号"
Label3(1) = "边距"
Label3(2) = "交角"
End If
End Sub

Sub 推算坐标()
Dim B As Double, J As Double
K = Val(Label3(0))
If K < Kjd(0) Or K > Kjd(JD + 1) Then MsgBox "这下没撤了!看着办吧": Exit Sub
B = Val(Label3(1))
J = 弧度(Val(Label3(2)))
平曲线计算
Label7(0) = Format(X + B * Cos(O + J), "0.000")
Label7(1) = Format(Y + B * Sin(O + J), "0.000")
End Sub

Function 弧度(ByVal dms As Double) As Double 'ByVal表示参数按值传递。
Dim d As Long, m As Long, s As Long
弧度 = Sgn(dms)
dms = Abs(dms)
d = Int(dms)
dms = (dms - d) * 100
m = Int(dms)
s = (dms - m) * 100
弧度 = (d + m / 60 + s / 3600) / 180 * Pi * 弧度
End Function

Sub 反算桩号()
Dim Nb As Double, Eb As Double, K0 As Double, K1 As Double, K2 As Double
Dim B As Double, Xb As Double, Yb As Double, J As Double, KK As Double
Nb = Val(Label7(0))
Eb = Val(Label7(1))
B = 100000000
K0 = Kjd(0)
K2 = Kjd(JD + 1)
KK = 100
Do While KK > 0.0001
For K = K0 To K2 Step KK
平曲线计算
If Sqr((Nb - X) * (Nb - X) + (Eb - Y) * (Eb - Y)) < B Then
K1 = K
B = Sqr((Nb - X) * (Nb - X) + (Eb - Y) * (Eb - Y))
Xb = X
Yb = Y
J = O
End If
Next
K0 = K1 - KK
If K0 < Kjd(0) Then K0 = Kjd(0)
K2 = K1 + KK
If K2 > Kjd(JD + 1) Then K2 = Kjd(JD + 1)
KK = KK / 10
Loop
Label3(1) = Format(B, "0.000")
If Abs(Nb - Xb - B * Cos(J + Pi / 2)) < Abs(Nb - Xb - B * Cos(J - Pi / 2)) Then
If Abs(Nb - Xb - B * Cos(J + Pi / 2)) < 0.1 Then Label3(2) = "90.0000"
Else
If Abs(Nb - Xb - B * Cos(J - Pi / 2)) < 0.1 Then Label3(2) = "-90.0000"
End If
'修正桩号
K0 = IIf(Kjd(0) > K1 - 0.01, Kjd(0), K1 - 0.01)
K2 = IIf(Kjd(JD + 1) < K1 + 0.01, Kjd(JD + 1), K1 + 0.01)
KK = 0.001
For K = K0 To K2 Step 0.001
J = 弧度(Val(Label3(2)))
平曲线计算
Xb = X + B * Cos(O + J)
Yb = Y + B * Sin(O + J)
If Abs(Nb - Xb) + Abs(Eb - Yb) < KK Then K1 = K: KK = Abs(Nb - Xb) + Abs(Eb - Yb)
Next
Label3(0) = Format(K1, "0.000")
If B < 0.001 Then Label3(1) = "边距": Label3(2) = "交角"
If B >= 0.001 And Label3(2) = "交角" Then Label3(0) = "桩号": Label3(1) = "边距": MsgBox "没有搞错?万能的上帝不在呀!"
End Sub

Sub 平曲线计算()
Dim F As Double
m = JD + 1
For i = 1 To JD
If K <= Kjd(i) - Th1(i) + Lh(i) Then m = i: Exit For
Next
If m = JD + 1 Then
Pol Njd(m) - Njd(m - 1), Ejd(m) - Ejd(m - 1)
O = W
Rec Kjd(m) - K, O + Pi
X = Njd(m) + V
Y = Ejd(m) + W
Exit Sub
End If
F = K - (Kjd(m) - Th1(m))
If F > Lh(m) - Ls2(m) Then '第二缓和曲线段
Pol Njd(m + 1) - Njd(m), Ejd(m + 1) - Ejd(m)
O = W
Rec Th2(m), O
X = Njd(m) + V
Y = Ejd(m) + W
F = Lh(m) - F
V = F - F ^ 5 / 40 / Ls2(m) / Ls2(m) / R(m) / R(m)
W = F ^ 3 / 6 / Ls2(m) / R(m) - F ^ 7 / 336 / Ls2(m) ^ 3 / R(m) ^ 3
Pol V, W
Rec V, O + Pi - W
X = X + V
Y = Y + W
O = O - F * F / 2 / Ls2(m) / R(m)
Else
Pol Njd(m) - Njd(m - 1), Ejd(m) - Ejd(m - 1)
O = W
If F <= 0 Then '直线段
Rec Th1(m) - F, O + Pi
X = Njd(m) + V
Y = Ejd(m) + W
Else
Rec Th1(m), O + Pi
X = Njd(m) + V
Y = Ejd(m) + W
If F <= Ls1(m) Then '第一缓和曲线段
V = F - F ^ 5 / 40 / Ls1(m) / Ls1(m) / R(m) / R(m)
W = F ^ 3 / 6 / Ls1(m) / R(m) - F ^ 7 / 336 / Ls1(m) ^ 3 / R(m) ^ 3
Pol V, W
Rec V, O + W
X = X + V
Y = Y + W
O = O + F * F / 2 / Ls1(m) / R(m)
Else '圆曲线段
If Ls1(m) <> 0 Then
V = Ls1(m) - Ls1(m) ^ 3 / 40 / R(m) / R(m)
W = Ls1(m) * Ls1(m) / 6 / R(m)
Pol V, W
Rec V, O + W
X = X + V
Y = Y + W
O = O + Ls1(m) / 2 / R(m)
F = F - Ls1(m)
End If
Rec 2 * R(m) * Sin(F / 2 / R(m)), O + F / 2 / R(m)
X = X + V
Y = Y + W
O = O + F / R(m)
End If
End If
End If
End Sub

'坐标反算
Sub Pol(ByVal X, ByVal Y)
V = Sqr(X * X + Y * Y)
If X = 0 Then
If Y > 0 Then W = Pi / 2
If Y < 0 Then W = Pi * 3 / 2
Else
W = Atn(Y / X) + IIf(X < 0, Pi, 0)
End If
End Sub

Sub Rec(ByVal X, ByVal Y)
V = X * Cos(Y)
W = X * Sin(Y)
End Sub

'Data.txt内容示例：
5
149941.938,3138083.910,472466.620,-1500,249.934,249.934,441.937,441.937,874.038
151678.460,3136634.749,471492.093,4000,0,0,691.261,691.261,1369.001
153529.904,3135526.195,469992.359,-5000,0,0,983.548,983.548,1942.298
155499.895,3133821.228,468956.851,1500,240,240,567.831,567.831,1109.560
156955.783,3133180.799,467614.947,-1200,205.206,205.206,635.630,635.630,1207.390
149500.000,3138319.676,472840.416,157527.544,3132571.776,467432.970
数据格式：角度格式（°′〃），正负值规定：平曲线半径左-右+
第一行输入：交点个数
以后每一行按顺序输入交点及平曲线要素：交点桩号，N坐标，E坐标，平曲线半径，缓和曲线长Ls1，Ls2，切线长Th1,Th2,曲线总长
最后一行输入：起点桩号，N坐标，E坐标，终点桩号，N坐标，E坐标

Answer 3

"线细部点坐标"是什么意思都不知道，老兄你应该说详细一点吧，“计算公路施工测量中线细部点坐标”是怎么回事不是写程序的人知道的，又怎么能做得出那样的程序呢？