form1.frm

一个简单的道路放样坐标计算程序

      End
      Begin VB.TextBox Text2 
         Height          =   270
         Left            =   1080
         TabIndex        =   4
         Text            =   "1000"
         Top             =   960
         Width           =   1095
      End
      Begin VB.TextBox Text1 
         Height          =   270
         Left            =   480
         TabIndex        =   3
         Text            =   "23"
         Top             =   360
         Width           =   495
      End
      Begin VB.Label Label20 
         Caption         =   "″"
         Height          =   135
         Left            =   2280
         TabIndex        =   43
         Top             =   360
         Width           =   135
      End
      Begin VB.Label Label19 
         Caption         =   "′"
         Height          =   135
         Left            =   1560
         TabIndex        =   41
         Top             =   360
         Width           =   255
      End
      Begin VB.Label Label2 
         Caption         =   "°"
         Height          =   135
         Left            =   960
         TabIndex        =   39
         Top             =   360
         Width           =   135
      End
      Begin VB.Label Label7 
         Caption         =   "JD里程"
         Height          =   375
         Left            =   120
         TabIndex        =   11
         Top             =   2520
         Width           =   735
      End
      Begin VB.Label Label6 
         Caption         =   "右偏"
         Height          =   255
         Left            =   1200
         TabIndex        =   8
         Top             =   2040
         Width           =   375
      End
      Begin VB.Label Label5 
         Caption         =   "左偏"
         Height          =   375
         Left            =   120
         TabIndex        =   7
         Top             =   2040
         Width           =   495
      End
      Begin VB.Label Label4 
         Caption         =   "缓和曲线长"
         Height          =   375
         Left            =   120
         TabIndex        =   5
         Top             =   1440
         Width           =   975
      End
      Begin VB.Label Label1 
         Caption         =   "半径 "
         Height          =   255
         Left            =   120
         TabIndex        =   2
         Top             =   960
         Width           =   375
      End
      Begin VB.Label Label3 
         Caption         =   "转角"
         Height          =   495
         Left            =   120
         TabIndex        =   1
         Top             =   360
         Width           =   375
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim A As Single, l As Single, cc As Integer, lo As Single, r As Single, kjd As Single, t As Single
Dim kyh, khy, kqz, kzh, khz, ll As Single
Dim xcz As Single, ycz As Single
Dim s, c, n As String
Const p = 3.1415926
Private Sub Command2_Click()
pp = 180 / p
Dim af As Integer
Dim Ao, Xo, Yo, x1, y1, b, Xi, Yi As Single
Dim Xzh, Yzh, Xjd, Yjd, Xhs, Yhs, Sbz, dx, dy As Single
Dim Xzb, Yzb, Xyb, Yyb, Ayb, Syb, Szb, Azb, Axi, Sxi As Single
Xzh = Text6.Text
Yzh = Text7.Text
Xjd = Text8.Text
Yjd = Text9.Text
xcz = Text10.Text
ycz = Text11.Text
Xhs = Text12.Text
Yhs = Text13.Text
Sbz = Text14.Text
ll = Text15.Text

Select Case ll

 Case kzh To khy

   Ao = Atn((Yzh - Yjd) / (Xzh - Xjd))
   Xo = Xjd + t * Cos(Ao + p)
   Yo = Yjd + t * Sin(Ao + p)

   li = ll - kzh
   x1 = li - li ^ 5 / (40 * r ^ 2 * lo ^ 2)
   y1 = li ^ 3 / (6 * r * lo)
   b = li ^ 2 * pp / (2 * r * lo)

   Xi = Xo + x1 * Cos(Ao) - cc * y1 * Sin(Ao)
   Yi = Yo + x1 * Sin(Ao) + cc * y1 * Cos(Ao)
   ai = Ao * pp + cc * b
  
Case khy To kyh

   li = ll - kzh
   Ao = Atn((Yzh - Yjd) / (Xzh - Xjd))
   Xo = Xjd + t * Cos(Ao + p)
   Yo = Yjd + t * Sin(Ao + p)

   x1 = li - (li - 0.5 * lo) ^ 3 / (6 * r ^ 2) - lo ^ 3 / (240 * r * r)
   y1 = (li - 0.5 * lo) ^ 2 / (2 * r) - (li - 0.5 * lo) ^ 4 / (24 * r ^ 3) + lo ^ 2 / (24 * r)
   b = (li - 0.5 * lo) / r * pp
 
   Xi = Xo + x1 * Cos(Ao) - cc * y1 * Sin(Ao)
   Yi = Yo + x1 * Sin(Ao) + cc * y1 * Cos(Ao)
   ai = Ao * pp + cc * b
Case kyh To khz

  Ao = Atn((Yzh - Yjd) / (Xzh - Xjd))
     Xo = Xjd + t * Cos(Ao + A * p / 180)
  Yo = Yjd + t * Sin(Ao + A * p / 180)
  Ao = Ao * pp + A + 180
  cc = -1 * cc
  li = l - (ll - kzh)
  
 
   x1 = li - li ^ 5 / (40 * r ^ 2 * lo ^ 2)
   y1 = li ^ 3 / (6 * r * lo)
   b = li ^ 2 * pp / (2 * r * lo)

   Xi = Xo + x1 * Cos(Ao * p / 180) - cc * y1 * Sin(Ao * p / 180)
   Yi = Yo + x1 * Sin(Ao * p / 180) + cc * y1 * Cos(Ao * p / 180)
   ai = Ao + cc * b
  
Case Is > khz
    li = ll - khz + t
   Ao = Atn((Yzh - Yjd) / (Xzh - Xjd))
   x1 = li * Cos(A * p / 180) + t
   y1 = li * Sin(A * p / 180)
   Xi = Xzh + x1 * Cos(Ao) - y1 * Sin(Ao)
   Yi = Yzh + x1 * Sin(Ao) + y1 * Cos(Ao)
  
 Case Is < kzh

   Ao = Atn((Yzh - Yjd) / (Xzh - Xjd))
   Xo = Xjd + t * Cos(Ao + p)
   Yo = Yjd + t * Sin(Ao + p)

   x1 = ll - kzh
   y1 = 0
   b = A
   Xi = Xo + x1 * Cos(Ao) - cc * y1 * Sin(Ao)
   Yi = Yo + x1 * Sin(Ao) + cc * y1 * Cos(Ao)
   ai = Ao * pp + cc * b

End Select
   
  Xzb = Xi + Sbz * Cos((ai - 90) * p / 180)
  Yzb = Yi + Sbz * Sin((ai - 90) * p / 180) '左边桩坐标
  
  Xyb = Xi + Sbz * Cos((ai + 90) * p / 180)
  Yyb = Yi + Sbz * Sin((ai + 90) * p / 180) '右边桩坐标
  
  Azb = -(Atn((Yhs - ycz) / (Xhs - xcz)) - Atn((Yzb - ycz) / (Xzb - xcz))) * 180 / p
  dx = Xzb - xcz
  dy = Yzb - ycz
  Szb = Abs(Sqr(dx ^ 2 + dy ^ 2))
  
  Ayb = -(Atn((Yhs - ycz) / (Xhs - xcz)) - Atn((Yyb - ycz) / (Xyb - xcz))) * 180 / p
  dx = Xyb - xcz
  dy = Yyb - ycz
  Syb = Abs(Sqr(dx ^ 2 + dy ^ 2))

  Axi = -(Atn((Yhs - ycz) / (Xhs - xcz)) - Atn((Yi - ycz) / (Xi - xcz))) * 180 / p
  'Axi = -Axi * 180 / p
 dx = Xi - xcz
  dy = Yi - ycz
  Sxi = Abs(Sqr(dx ^ 2 + dy ^ 2))
       
     Xzb = Format(Xzb, "######.0000")
     Yzb = Format(Yzb, "######.0000")
     Xi = Format(Xi, "######.0000")
     Yi = Format(Yi, "######.0000")
     Xyb = Format(Xyb, "######.0000")
     Yyb = Format(Yyb, "######.0000")
     
     Azb = angle(Azb) 'Format(Azb, "#######.0000")
     Axi = angle(Axi) 'Format(Axi, "#######.0000")
     Ayb = angle(Ayb) 'Format(Ayb, "#######.0000")
     
     Szb = Format(Szb, "#######.0000")
     Sxi = Format(Sxi, "#######.0000")
     Syb = Format(Syb, "#######.0000")
    
    s = Space(1) & "里程" & Space(3) & "桩位" & Space(5) & "X坐标" & Space(8) & "Y坐标" & Space(7) & "水平夹角" & Space(5) & "水平距离" & Chr(13) & Chr(10)
    m = m & Space(7) & "左边桩" & Space(2) & Xzb & Space(3) & Yzb & Space(3) & Azb & Space(2) & Szb & Chr(13) & Chr(10)
    m = m & Space(1) & ll & Space(3) & "中桩" & Space(3) & Xi & Space(4) & Yi & Space(4) & Axi & Space(2) & Sxi & Chr(13) & Chr(10)
    m = m & Space(7) & "右边桩" & Space(2) & Xyb & Space(3) & Yyb & Space(3) & Ayb & Space(2) & Syb & Chr(13) & Chr(10)
    n = n & m & Chr(13) & Chr(10)
      Text17.Text = s & n
    
End Sub

Private Sub Command1_Click()
Dim eo, q As Single
Dim a1, a2, a3 As Single
a1 = Text1.Text
a2 = Text5.Text
a3 = Text16.Text
r = Text2.Text
lo = Text3.Text
kjd = Text4.Text
A = a1 + a2 / 60 + a3 / 3600
t = lo / 2 - (lo ^ 3) / (240 * r * r) + (r + (lo ^ 2) / (24 * r)) * Tan(A * p / 360)
l = (A * r * p) / 180 + lo
eo = (r + (lo * lo) / (24 * r)) / Cos(A * p / 360) - r
q = 2 * t - l

kzh = kjd - t
khy = kjd - t + lo
kqz = kzh + l / 2
khz = kqz + l / 2
kyh = khz - lo

Command2.Enabled = True
eo = Format(eo, "#######.00000")

c = Space(20) & "计算结果" & Chr(13) & Chr(10) & Chr(13) & Chr(10)
c = c & Space(5) & "切线长" & Space(4) & t & Space(8) & "zh里程" & Space(3) & kzh & Chr(13) & Chr(10) & Chr(13) & Chr(10)
c = c & Space(5) & "曲线长" & Space(4) & l & Space(8) & "hy里程" & Space(3) & khy & Chr(13) & Chr(10) & Chr(13) & Chr(10)
c = c & Space(5) & "外矢距" & Space(4) & eo & Space(8) & "qz里程" & Space(3) & kqz & Chr(13) & Chr(10) & Chr(13) & Chr(10)
c = c & Space(5) & "切曲线" & Space(4) & q & Space(8) & "yh里程" & Space(3) & kyh & Chr(13) & Chr(10) & Chr(13) & Chr(10)
c = c & Space(31) & "hz里程" & Space(3) & khz & Chr(13) & Chr(10)
Text29.Text = c
End Sub
Private Sub Command3_Click()
End
End Sub
Private Sub Form_Load()
Command2.Enabled = False
End Sub
Private Sub Option1_Click()
cc = -1
End Sub
Private Sub Option2_Click()
cc = 1
End Sub
Private Function angle(ss)
Dim s  As String
s = Str(ss) '将数字转化为字符
i = InStr(s, ".") - 1
If i < 1 Then '角度值是整数
 angle = s
Else
 b = Fix(ss)
 c = Fix((ss - b) * 60)
 d = ((ss - b) * 60 - Fix((ss - b) * 60)) * 60
 d = Format(d, "00")
 c = Format(d, "00")
 s = b & "°" & c & "′" & d & "″"
 angle = s
End If
End Function