图幅号与经纬度的换算

图幅号,如“I48E001004”,一般为10位数。

前三位“I48”表示所属1:100万图幅的行列号

,地图基本都是在1:100万比例尺的行列式编号基础上划分的。

1:100万图幅的划分规则:

纬度行:从赤道开始算,纬度四度一行,南北纬各22行,用大写英文字母A,B,C…表示(南半球要在字母后面加S,北半球加N)
----“I”是第九位数字,对应的是32°-36°的范围。

经度列:180度经线开始算,自西向东六度一列,全球共360/6=60列,用1,2,3…表示。
----“48”是从180度经线开始的第48个列,而从180°经线到0°经线是180/6=30列,所以对应的经度范围是102°-108°的范围。

第四位代表该图幅的比例尺

在这里插入图片描述
----“E”表示这是1:5万的图幅

后六位代表该图幅的行列号

1:5万图幅,纬差为:10’,
----“001”是在36°以下第一个10′处,即35°50′-36°
1:5万图幅,经差为:15’,
----“004”是在102°之后第4个15′处,即102°45-103°
在这里插入图片描述

反过来,已知某地的经纬度,求它所属的1:5万图幅号

如西安的经度范围:107.40°E~109.49°E
纬度范围:33.42°N~34.45°N

先求所属的1:100万图幅号
纬度行:从赤道开始算,纬度四度一行,
33.42 / 4=8……1.42
34.45 / 4=8……2.45
所以西安属于从赤道往北第9个纬度行,即 I

经度列:180度经线开始算,自西向东六度一列,从180°经线到0°经线是180/6=30列,
107.40/6=17……5.40
109.49/6=18……1.49
所以西安所属从180°经线往东第48、49个经度列,即 48、49

五万图幅是E

第9个纬度行为32°–36°
36°-33.42°=2.18°=138′
1:5万图幅,纬差为:10’,
138′/10=13……8′,即第14个纬差行,即014
同样,36°-34.45°=1.15°=75′
75′/10=7……5芬,即第8个纬差行,即008
所以,西安所占的五万图幅为 I 内的008、009、010、011、012、013、014

第48个经度列为102°E–108°E
107.40-102=5.40°=340′
340′ / 15=22……10′,即第23个经差列
第49个经度列为108°E–114°E
109.49-108=1.49°=109′
109′ / 15=7……4′,即第8个经差列
所以,西安所占的五万图幅为48内的023、024,49内的001、002、003、004、005、006、007、008

所以西安所占的五万图幅为:
在这里插入图片描述
在这里插入图片描述
不过软件里已经可以设置好行政区域及经纬度范围后,自动计算出该地的五万图幅号了~

'计算 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
评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值