'计算图幅号
Option Explicit
Type ArrayData
Data() As String
Count As Integer
End Type
Public Function getSheetNumber(strLat As String, strLon As String, ScaleID As String) As String
Dim strLatErr As String, strLonErr As String
Dim dblLatErr As String, dblLonErr As String
Dim dblLat As Double, dblLon As Double
Dim a As String, b As Integer, c As Integer, d As Integer
Select Case ScaleID
Case "A" '1:100W
strLatErr = "4°00′00″": strLonErr = "6°00′00″"
Case "B" '1:50W
strLatErr = "2°00′00″": strLonErr = "3°00′00″"
Case "C" '1:25W
strLatErr = "1°00′00″": strLonErr = "1°30′00″"
Case "D" '1:10W
strLatErr = "00°20′00″": strLonErr = "00°30′00″"
Case "E" '1:5W
strLatErr = "00°10′00″": strLonErr = "00°15′00″"
Case "F" '1:2.5W
strLatErr = "00°05′00″": strLonErr = "00°07′30″"
Case "G" '1:1W
strLatErr = "00°02′30″": strLonErr = "00°03′45″"
Case "H" '1:0.5W
strLatErr = "00°01′15″": strLonErr = "00°01′52.5″"
Case Else '
getSheetNumber = "比例尺代码错误"
Exit Function
End Select
dblLatErr = changeToSecond(strLatErr): dblLonErr = changeToSecond(strLonErr)
dblLat = changeToSecond(strLat): dblLon = changeToSecond(strLon)
a = Chr(64 + Int(dblLat / changeToSecond("4°00′00″")) + 1)
b = Int(dblLon / changeToSecond("6°00′00″") + 31)
If ScaleID <> "A" Then
c = changeToSecond("4°00′00″") / dblLatErr - Int(mMod(dblLat, changeToSecond("4°00′00″")) / dblLatErr)
d = Int(mMod(dblLon, changeToSecond("6°00′00″")) / dblLonErr) + 1
getSheetNumber = a & b & ScaleID & Format(c, "000") & Format(d, "000")
Else
getSheetNumber = a & b
End If
End Function
Private Function changeToSecond(strDeg As String) As Double
Dim intD As Integer, intM As Integer, dblS As Double
intD = Int(strOperate(strDeg, "°").Data(0))
dblS = CDbl(Left(strOperate(strDeg, "′").Data(1), Len(strOperate(strDeg, "′").Data(1)) - 1))
intM = Int(Left(strOperate(strDeg, "°").Data(1), 2))
changeToSecond = intD * 60 + intM + dblS / 60
End Function
Private Function strOperate(ByVal strX As String, ByVal strA As String) As ArrayData '分割字符串
Dim i As Integer, j As Integer, k As Integer
Dim cnt As Integer, strTemp As String
If Trim(strA) <> "" Then
strX = Trim(strX)
strA = Trim(strA)
strX = strX & strA
For i = 1 To Len(strX)
If Mid(strX, i, Len(Trim(strA))) = strA Then
cnt = cnt + 1
i = i + Len(strA) - 1
End If
Next i
strOperate.Count = cnt
ReDim strOperate.Data(cnt - 1)
For j = 1 To Len(strX)
If Mid(strX, j, Len(strA)) = strA Then
strOperate.Data(k) = Left(strX, j - 1)
strX = Trim(Right(strX, Len(strX) - Len(strOperate.Data(k)) - Len(strA)))
k = k + 1
j = 0
End If
Next j
Else
strX = Trim(strX)
strTemp = strX
For i = 1 To Len(strTemp)
If Mid(strTemp, i, 1) = " " Then
cnt = cnt + 1
strTemp = Trim(Right(strTemp, Len(strTemp) - i + 1))
i = 0
End If
Next i
strX = strX & " "
strOperate.Count = cnt + 1
ReDim strOperate.Data(cnt)
For i = 1 To Len(strX)
If Mid(strX, i, 1) = " " Then
strOperate.Data(j) = Left(strX, i - 1)
strX = LTrim(Right(strX, Len(strX) - i + 1))
j = j + 1
i = 0
End If
Next i
End If
End Function
Private Function mMod(dblF As Double, dblS As Double) As Double
Dim intM As Integer
intM = Int(dblF / dblS)
mMod = dblF - dblS * intM
End Function
Private Sub Form_Load()
Text1 = getSheetNumber("39°22′30″", "114°33′45″", "A")
Text1 = Text1 & vbCrLf & getSheetNumber("39°22′30″", "114°33′45″", "B")
Text1 = Text1 & vbCrLf & getSheetNumber("39°22′30″", "114°33′45″", "C")
Text1 = Text1 & vbCrLf & getSheetNumber("39°22′30″", "114°33′45″", "D")
Text1 = Text1 & vbCrLf & getSheetNumber("39°22′30″", "114°33′45″", "E")
Text1 = Text1 & vbCrLf & getSheetNumber("39°22′30″", "114°33′45″", "F")
Text1 = Text1 & vbCrLf & getSheetNumber("39°22′30″", "114°33′45″", "G")
Text1 = Text1 & vbCrLf & getSheetNumber("39°22′30″", "114°33′45″", "H")
End Sub
