标准分幅下的图幅号转换成经纬度坐标【原理+源代码】

最近要批量的把标准分幅下的图幅号转换成经纬度坐标,所以这两天写了个程序来搞定这件事情。
先举个例子说明一下这个程序的作用。
例如:计算出图幅号I50G021040的经纬度范围,即最大经度、最小经度、最大纬度、最小纬度。
运用我编写的这个程序,可以直接算出来,这个图幅号的经纬度范围,最大经度为115.3125°,最小经度为115.25°,最大纬度为31.167°,最小纬度为31.125°。
说一下转换的原理吧。

原理

我国的基本比例尺有7种:1:1万,1:2.5万,1:5万,1:10万,1:25万,1:50万,1:100万。
根据国家标准规定,我国基本比例尺地形图均以1:100万地形图位基础,按规定的经差和纬差划分图幅。其中,1:100万地形图的分幅采用国际1:100万地图分幅标准。每幅1:100万地形图的范围是经差6°、纬差4°;纬度60°-76°为经差12°、纬差4°;纬度76°-88°之间经差24°、纬差4°。(中国在1:100万分幅中都是按经差6°、纬差4°分幅的)
100万地形图的分幅和编号(北半球)
1幅1:100万地形图可以划分成4(2*2)幅1:50万地形图、16(4*4)幅1:25万地形图、144(12*12)幅1:10万地形图、576(24*24)幅1:5万地形图、2304(48*48)幅1:2.5万地形图、9216(96*96)幅1:1万地形图、36864(192*192)幅1:0.5万地形图。
这里写图片描述
由于历史原因,我国地形图的编号在20世纪90年代以前很不统一。20世纪90年代以后,1:1 000 000-1:5000地形图的编号均以1:1 000 000地形图编号为基础,采用行列编号的方法。将1:1 000 000地形图按所含各比例尺地形图的经差和纬差划分成若干行和列,横行从上到下、纵列从左到右按顺序分别用3位阿拉伯数字(数字码)表示,不足3位者前面补零,取行号在前、列号在后的排列形式标记;各种比例尺地形图分别采用不同的字符作为其比例尺代码。
比例尺代码


接下来,把图幅号分解开来讲解。以上面提到的I50G021040图幅号为例。

  1. I,表示的是1:100万行号;50,表示的是1:100万列号。用于表示此范围在1:100万分幅地形图下的经纬度范围,即最大纬度是32°N,最小纬度是28°N,最大经度是120°,最小经度是114°。(查看前面的分幅图可知道:I,表示28°-32°N范围;50,表示114°-120°E)
  2. G,表示的是比例尺代码。用于记录地形图的实际比例尺。根据前面的比例尺代码表格可知,G表示1:10000比例尺,即1幅1:1 000 000地形图划分成96*96幅1:10000地形图。据此,我们可以算出1幅1:10000地形图的纬差为:6/96°,经差为:4/96°。
  3. 021,表示的是图幅行号数字码;040,表示的是图幅列号数字码。用于确定该地形图确切的经纬度范围。由于此图幅号为96*96,所以图幅行号和列号数字码都不能超过096。
    据此我们可以算出此图幅号的最大纬度、最小纬度、最大经度、最小经度。
    最大纬度=1:1 000 000地形图的最大纬度-(图幅行号数字码-1)*1:10000地形图的纬差=32°N - (21-1)*6/96°=31.1667°N
    最小纬度=最大纬度-纬度差=31.1667°N-6/96°=31.125°N
    最小经度=1:1 000 000地形图的最小经度+(图幅列数数字码-1)*1:10000地形图的经差=114°E+(40-1)*4/96°=115.25°E
    最大经度=最小经度+1:10000地形图的经差=115.25°E+4/96°=115.3125°E

程序代码

核心算法部分代码:

        #region
  • 5
    点赞
  • 23
    收藏
    觉得还不错? 一键收藏
  • 6
    评论
'计算图幅 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
评论 6
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

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

抵扣说明:

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

余额充值