form1.frm

铁路及公路中线坐标计算程序

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form Form1 
   Caption         =   "线路中桩坐标计算-勘测大队"
   ClientHeight    =   4440
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   5700
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4440
   ScaleWidth      =   5700
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "取  消"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   2880
      TabIndex        =   17
      Top             =   3600
      Width           =   1695
   End
   Begin VB.Frame Frame3 
      Caption         =   "输出信息"
      Height          =   1335
      Left            =   2760
      TabIndex        =   13
      Top             =   1680
      Width           =   2775
      Begin VB.OptionButton Option10 
         Caption         =   "计算切线上坐标"
         Height          =   255
         Left            =   120
         TabIndex        =   18
         Top             =   960
         Width           =   1935
      End
      Begin VB.OptionButton Option9 
         Caption         =   "输出五大桩坐标"
         Height          =   255
         Left            =   120
         TabIndex        =   16
         Top             =   720
         Width           =   1935
      End
      Begin VB.OptionButton Option5 
         Caption         =   "仅输出计算切线信息"
         Height          =   255
         Left            =   120
         TabIndex        =   15
         Top             =   480
         Width           =   1935
      End
      Begin VB.OptionButton Option4 
         Caption         =   "输出中桩点坐标"
         Height          =   255
         Left            =   120
         TabIndex        =   14
         Top             =   240
         Value           =   -1  'True
         Width           =   1935
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "输出格式"
      Height          =   2775
      Left            =   120
      TabIndex        =   6
      Top             =   240
      Width           =   2055
      Begin VB.OptionButton Option8 
         Caption         =   "TC1610"
         Height          =   180
         Left            =   240
         TabIndex        =   12
         Top             =   2400
         Width           =   1215
      End
      Begin VB.OptionButton Option7 
         Caption         =   "TC1102-8"
         Height          =   180
         Left            =   240
         TabIndex        =   11
         Top             =   1992
         Width           =   1215
      End
      Begin VB.OptionButton Option6 
         Caption         =   "Cass格式"
         Height          =   180
         Left            =   240
         TabIndex        =   10
         Top             =   1176
         Width           =   1215
      End
      Begin VB.OptionButton Option3 
         Caption         =   "TC1102-16"
         Height          =   180
         Left            =   240
         TabIndex        =   9
         Top             =   1584
         Width           =   1215
      End
      Begin VB.OptionButton Option2 
         Caption         =   "空格"
         Height          =   180
         Left            =   240
         TabIndex        =   8
         Top             =   768
         Width           =   1215
      End
      Begin VB.OptionButton Option1 
         Caption         =   "逗号"
         Height          =   180
         Left            =   240
         TabIndex        =   7
         Top             =   360
         Value           =   -1  'True
         Width           =   1215
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "信息"
      Height          =   1215
      Left            =   2760
      TabIndex        =   1
      Top             =   240
      Width           =   2775
      Begin VB.TextBox Text2 
         Height          =   270
         Left            =   1200
         TabIndex        =   5
         Text            =   "10"
         Top             =   720
         Width           =   975
      End
      Begin VB.TextBox Text1 
         Height          =   270
         Left            =   1200
         TabIndex        =   3
         Text            =   "4900"
         Top             =   360
         Width           =   975
      End
      Begin VB.Label Label2 
         Caption         =   "间距"
         Height          =   255
         Left            =   120
         TabIndex        =   4
         Top             =   720
         Width           =   735
      End
      Begin VB.Label Label1 
         Caption         =   "起点里程"
         Height          =   255
         Left            =   120
         TabIndex        =   2
         Top             =   360
         Width           =   855
      End
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确  定"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   240
      TabIndex        =   0
      Top             =   3600
      Width           =   1695
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   2160
      Top             =   3000
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const pi As Double = 3.14159265358979

Private Sub Command1_Click()
Dim xy(), x()
Dim qxxx() As Double
'存放计算切线信息
Dim wdzh()  As Double
'存放五大桩坐标
Dim lll(3) As Double
Dim xxx(3) As Double
Dim yyy(3) As Double


CommonDialog1.ShowOpen
On Error GoTo errorhandler
Open CommonDialog1.FileName For Input As #1
Do While Not EOF(1)
Input #1, x1, y1
Input #1, x2, y2, r, l0
Input #1, x3, y3
jj = Val(Text2.Text)
qdlc = Val(Text1.Text)
s = Sqr((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2))
a1 = xlu(x2, y2, x1, y1)
a2 = xlu(x2, y2, x3, y3)
a3 = a1 - pi
If a3 < 0 Then a3 = a3 + 2 * pi
a = Abs(a2 - a3)
If a > pi Then a = 2 * pi - a
If a1 > pi And a2 > a1 - pi And a2 < a1 Or a1 < pi And a2 > a1 + pi And a2 < a1 + 2 * pi Then
w = 1                 '右偏，W取1
ElseIf a1 > pi And (a2 < a1 - pi Or a2 > a1) Or a1 < pi And a2 > a1 And a2 < a1 + pi Then
w = 2                  '左偏，W取2
End If
b0 = l0 / (2 * r): m = l0 / 2 - l0 * l0 * l0 / (240 * r * r): p = l0 * l0 / (24 * r)
t = m + (r + p) * Tan(a / 2): l = r * (a - 2 * b0) + 2 * l0
e = (r + p) / Cos(a / 2) - r: q = 2 * t - l
a = du(a)
lzh = qdlc + s - t: xzh = x2 + t * Cos(a1): yzh = y2 + t * Sin(a1)
lhz = lzh + l: xhz = x2 + t * Cos(a2): yhz = y2 + t * Sin(a2)
nn = nn + 1
ReDim Preserve qxxx(1 To 6 * nn)
qxxx(6 * nn - 5) = Format(x2, "0.000")
qxxx(6 * nn - 4) = Format(y2, "0.000")

qxxx(6 * nn - 3) = Format(t, "0.000")
qxxx(6 * nn - 2) = Format(t, "0.000")
qxxx(6 * nn - 1) = Format(lzh, "0.000")
qxxx(6 * nn) = Format(lhz, "0.000")
If t > s Then
MsgBox "切线太长。", , "确定"
Exit Sub
End If
If Sqr((x1 - xzh) * (x1 - xzh) + (y1 - yzh) * (y1 - yzh)) < jj Then GoTo 2
xy() = 直线(x1, y1, qdlc, jj, xzh, yzh)
n = UBound(xy()) / 3
n1 = n1 + n
ReDim Preserve x(1 To 3 * (n1 + n2 + n3))
For i = 1 To n
x(3 * (n1 + n2 + n3 + i - n) - 2) = xy(3 * i - 2)
x(3 * (n1 + n2 + n3 + i - n) - 1) = xy(3 * i - 1)
x(3 * (n1 + n2 + n3 + i - n)) = xy(3 * i)
Next
2: xy() = 缓和曲线(xzh, yzh, xhz, yhz, l0, jj, lzh, l, r, m, p, a3, a2, w)
n = UBound(xy()) / 3 - 5
n2 = n2 + n
ReDim Preserve x(1 To 3 * (n1 + n2 + n3))
For i = 1 To n
x(3 * (n1 + n2 + n3 + i - n) - 2) = xy(3 * i - 2)
x(3 * (n1 + n2 + n3 + i - n) - 1) = xy(3 * i - 1)
x(3 * (n1 + n2 + n3 + i - n)) = xy(3 * i)
Next
wn = wn + 5
ReDim Preserve wdzh(1 To 3 * wn)
For i = 1 To 5
wdzh(3 * (wn - 5 + i) - 2) = xy(3 * (n + i) - 2)
wdzh(3 * (wn - 5 + i) - 1) = xy(3 * (n + i) - 1)
wdzh(3 * (wn - 5 + i)) = xy(3 * (n + i))
Next
If Not EOF(1) Then
Input #1, r, l0, x4, y4
a1 = xlu(x3, y3, x2, y2)
a2 = xlu(x3, y3, x4, y4)
a3 = a1 - pi
If a3 < 0 Then a3 = a3 + 2 * pi
a = Abs(a2 - a3)
If a > pi Then a = 2 * pi - a
If a1 > pi And a2 > a1 - pi And a2 < a1 Or a1 < pi And a2 > a1 + pi And a2 < a1 + 2 * pi Then
w = 1                 '右偏，W取1
ElseIf a1 > pi And (a2 < a1 - pi Or a2 > a1) Or a1 < pi And a2 > a1 And a2 < a1 + pi Then
w = 2                  '左偏，W取2
End If
b0 = l0 / (2 * r): m = l0 / 2 - l0 * l0 * l0 / (240 * r * r): p = l0 * l0 / (24 * r)
t = m + (r + p) * Tan(a / 2): l = r * (a - 2 * b0) + 2 * l0
e = (r + p) / Cos(a / 2) - r: q = 2 * t - l
a = du(a)
xzh = x3 + t * Cos(a1): yzh = y3 + t * Sin(a1)
xy() = 直线(xhz, yhz, lhz, jj, xzh, yzh)
n = UBound(xy()) / 3
n3 = n3 + n
ReDim Preserve x(1 To 3 * (n1 + n2 + n3))
For i = 1 To n
x(3 * (n1 + n2 + n3 + i - n) - 2) = xy(3 * i - 2)
x(3 * (n1 + n2 + n3 + i - n) - 1) = xy(3 * i - 1)
x(3 * (n1 + n2 + n3 + i - n)) = xy(3 * i)
Next
s = Sqr((xzh - xhz) * (xzh - xhz) + (yzh - yhz) * (yzh - yhz))
xhz = x3 + t * Cos(a2): yhz = y3 + t * Sin(a2)
lzh = lhz + s
lhz = lzh + l
x2 = x3: y2 = y3
x3 = x4: y3 = y4
nn = nn + 1
ReDim Preserve qxxx(1 To 6 * nn)
qxxx(6 * nn - 5) = Format(x2, "0.000")
qxxx(6 * nn - 4) = Format(y2, "0.000")
qxxx(6 * nn - 3) = Format(t, "0.000")
qxxx(6 * nn - 2) = Format(t, "0.000")
qxxx(6 * nn - 1) = Format(lzh, "0.000")
qxxx(6 * nn) = Format(lhz, "0.000")
GoTo 2
Else
xy() = 直线(xhz, yhz, lhz, jj, x3, y3)
n = UBound(xy()) / 3
n3 = n3 + n
ReDim Preserve x(1 To 3 * (n1 + n2 + n3))
For i = 1 To n
x(3 * (n1 + n2 + n3 + i - n) - 2) = xy(3 * i - 2)
x(3 * (n1 + n2 + n3 + i - n) - 1) = xy(3 * i - 1)
x(3 * (n1 + n2 + n3 + i - n)) = xy(3 * i)
Next
End If
Loop
Close #1
If Option4.Value Then
CommonDialog1.ShowSave
Open CommonDialog1.FileName For Output As #2
For i = 1 To n1 + n2 + n3
x(3 * i - 1) = Format(x(3 * i - 1), "0.000")
x(3 * i) = Format(x(3 * i), "0.000")
If Option1.Value Then
Print #2, x(3 * i - 2) & "," & x(3 * i - 1) & "," & x(3 * i)
ElseIf Option2.Value Then
Print #2, x(3 * i - 2), x(3 * i - 1), x(3 * i)
ElseIf Option3.Value Then
Dim s1 As String * 4
Dim s2 As String * 16
Dim s3 As String * 16
Dim s4 As String * 16
If i <= 9999 Then
s1 = 加0(4, i)
Else
If int1 = 1 Then GoTo 21
int1 = MsgBox("数据的数量大于9999，是否改变序号输出？", , "确定")
If int1 = vbOK Then
21: s1 = 9999
End If
End If
If Len(x(3 * i - 2)) <= 16 Then
s2 = 加0(16, x(3 * i - 2))
Else
If int2 = 1 Then GoTo 22
int2 = MsgBox("点的里程位数大于16，是否依然输出？", , "确定")
If int2 = vbOK Then
22:  s2 = Right(x(3 * i - 2), 16)
End If
End If
If x(3 * i - 1) > 0 Then
fh1 = "+"
Else
fh1 = "-"
End If

x(3 * i - 1) = x(3 * i - 1) * 1000
If Len(x(3 * i - 1)) <= 16 Then
s4 = 加0(16, x(3 * i - 1))
Else
If int3 = 1 Then GoTo 23
int3 = MsgBox("点的X坐标位数大于16，是否依然输出？", , "确定")
If int3 = vbOK Then
23:  s4 = Right(x(3 * i - 1), 16)
End If
End If
If x(3 * i) > 0 Then
fh2 = "+"
Else
fh2 = "-"
End If
x(3 * i) = x(3 * i) * 1000
If Len(x(3 * i)) <= 16 Then
s3 = 加0(16, x(3 * i))
Else
If int4 = 1 Then GoTo 24
int4 = MsgBox("点的Y坐标位数大于16，是否依然输出？", , "确定")