📄 路阻求取(一车,两站点).bas
字号:
Attribute VB_Name = "Module7"
Public NearestStationNum As String
Public Sub TotalImpedence(Bush As String, Busfx As Integer, _
Stationxl() As String, Stationgs As Integer)
'Bush--公交车号;Busfx--公交车方向;Stationxl--公交站点序列;Stationgs--公交站点个数
Dim i As Integer
Impedence = 0
Select Case Funit
Case "Distance"
For i = 1 To Stationgs - 1
Impedence = Impedence + ImpedenceDistance(Bush, Busfx, Stationxl(i))
Next i
Case "Time"
For i = 1 To Stationgs - 1
Impedence = Impedence + ImpedenceTime(Bush, Busfx, Stationxl(i))
Next i
Case "Cost"
For i = 1 To Stationgs - 1
Impedence = Impedence + ImpedenceCost(Bush, Busfx, Stationxl(i))
Next i
Case "Syn"
For i = 1 To Stationgs - 1
Impedence = Impedence + ImpedenceSyn(Bush, Busfx, Stationxl(i))
Next i
End Select
End Sub
'求两站点之间的距离(米)
Public Function MidL(Station1 As String, Station2 As String) As Single
Dim LL As Single
If XSStationName(Station1) = XSStationName(Station2) Then '上下车的转乘站点为同一个
MidL = 0
Else
LL = Sqr((Longitude(Val(Station1)) * 3600 - Longitude(Val(Station2)) * 3600) ^ 2 + _
(Latitude(Val(Station1)) * 3600 - Latitude(Val(Station2)) * 3600) ^ 2)
If LL <= 3 Then '上下车的转乘站点为相距在100米之内的两个站点
MidL = 100 / 1000
Else '上下车的转乘站点为相距较远
MidL = LL * 100 / 3 / 1000 + 1000 '以公里为单位(表示两点间不可步行换乘,"+1000"是附加项)
End If
End If
End Function
'求距离给定的某一点最近的公交站点
Public Function NearestStation(x As Double, y As Double)
Dim i As Integer
Dim MinDis As Single
Dim Dis As Single
Dim str As String
MinDis = 1000
For i = 1 To TotalStation
Dis = Sqr((Longitude(i) * 3600 - x * 3600) ^ 2 + _
(Latitude(i) * 3600 - y * 3600) ^ 2)
If MinDis > Dis Then
MinDis = Dis
NearestStationNum = CStr(i) '找到的是XS(显示)用的公交站点
End If
Next i
str = "*," & NearestStationNum & ",*"
For i = 1000 To 2000
If (SamenameStationStr(i) Like str) Then
NearestStationNum = CStr(i) '找到的是CX(查询)用的公交站点
End If
Next i
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -