按:通过其他的程序进行坐标转换有点麻烦,好像也没有好用的程序库,其实常用的就是着两个之间的转换,自己写坐标系定义也太麻烦了,找了找公式,自己按照公式也写一下,据说这样转换有误差,比较了一下,几十米吧,将就够用了。
'************************************************************************
'高斯克吕格与经纬度坐标值转换代码
'Writen by Rodger Yuan 9 5 2006
'参考文献
'v0 0.1
'用于在经纬度坐标和高斯克吕格坐标之间的转换。
'高斯克吕格为一种投影,根据椭球体和基准面不同又有所区分,常用的北京54和西安80即
'采用这种投影方式,投影后的坐标为平面坐标系,单位为米
'现在参数的坐标系采用测绘坐标系,x为纵坐标,y为横坐标
'返回参数为自定义类型,双精度点
'调用转换函数前需要调用初始化过程进行初始化
'-------------------------------------------------------------------------------
'Public Sub init(ByVal TuoqiuCanshu As Canshu, ByVal Daihao As Integer)
'说明: 用于初始化转换参数
'TuoqiuCanshu  枚举类型,提供北京54、西安80和WGS84三个椭球参数
'Daihao  整型  为高斯克吕格投影六度分带带号,取值为1~60
'-------------------------------------------------------------------------------
'Public Sub initEx(ByVal dE As Double, ByVal dN As Double, ByVal k0 As Double)
'说明: 用于进一步初始化转换参数(暂不提供)
'dE  东偏移
'dE  北偏移
'k0  比例因子
'-------------------------------------------------------------------------------
'Public Function JWgetGK(ByVal W As Double, ByVal J As Double) As PointD

'************************************************************************
'基本变量定义
Dim a As Double '椭球体长半轴
Dim b As Double '椭球体短半周
Dim f As Double '扁率
Dim e As Double '第一偏心率
Dim eq As Double '第二偏心率

Dim dh As Integer '带号
Dim FE As Double '东偏移
Dim FN As Double '北偏移
Dim L0 As Double '中央经度
Dim k0 As Double '比例因子

Const PI As Double = 3.14159265358979
Public Enum Canshu
    Beijing54 = 0
    Xian80 = 1
    WGS84 = 2
End Enum
Public Type PointD
    X As Double
    Y As Double
End Type

Public Sub init(ByVal TuoqiuCanshu As Canshu, ByVal Daihao As Integer)
Select Case TuoqiuCanshu
'Krassovsky (北京54采用) 6378245 6356863.0188
'IAG 75(西安80采用) 6378140 6356755.2882
'WGS 84 6378137 6356752.3142

Case 0: '北京五四
    a = 6378245
    b = 6356863.0188
Case 1: '西安八零
    a = 6378140
    b = 6356755.2882
Case 2: 'WGS84
    a = 6378137
    b = 6356752.3142
End Select
f = (a - b) / a
e = Sqr(1 - (b / a) ^ 2)
eq = Sqr((a / b) ^ 2 - 1)

If Daihao < 1 Or Daihao > 60 Then Exit Sub
dh = Daihao

L0 = (6 * dh - 3) * PI / 180
k0 = 1
FE = 500000 + dh * 1000000
FN = 0

End Sub
Public Sub initEx(ByVal dE As Double, ByVal dN As Double, ByVal dk0 As Double)

End Sub
Public Function JWgetGK(ByVal W As Double, ByVal J As Double) As PointD
'给出经纬度坐标,转换为高克投影坐标
Dim BY As Double
Dim LX As Double
Dim TC As Double
Dim CC As Double
Dim AC As Double
Dim MC As Double
Dim NC As Double

Dim rx As Double
Dim ry As Double
Dim resultP As PointD
BY = W * PI / 180
LX = J * PI / 180
TC = Math.Tan(BY) ^ 2
CC = eq ^ 2 * Cos(BY) ^ 2
AC = (LX - L0) * Cos(BY)
MC = a * ((1 - e ^ 2 / 4 - 3 * e ^ 4 / 64 - 5 * e ^ 6 / 256) * BY - (3 * e ^ 2 / 8 + 3 * e ^ 4 / 32 + 45 * e ^ 6 / 1024) * Sin(2 * BY) + (15 * e ^ 4 / 256 + 45 * e ^ 6 / 1024) * Sin(4 * BY) - (35 * e ^ 6 / 3072) * Sin(6 * BY))
NC = a / Sqr(1 - e ^ 2 * (Sin(BY)) ^ 2)
rx = k0 * (MC + NC * Tan(BY) * (AC ^ 2 / 2 + (5 - TC + 9 * CC + 4 * CC ^ 2) * AC ^ 4 / 24) + (61 - 58 * TC + T ^ 2 + 270 * CC - 330 * TC * CC) * AC ^ 6 / 720)
ry = FE + k0 * NC * (AC + (1 - TC + CC) * AC ^ 3 / 6 + (5 - 18 * TC + TC ^ 2 + 14 * CC - 58 * TC * CC) * AC ^ 5 / 120)
resultP.X = rx
resultP.Y = ry
JWgetGK = resultP
End Function

Public Function GKgetJW(ByVal X As Double, ByVal Y As Double) As PointD
'给出高克投影坐标,转换为经纬度坐标
Dim BY As Double
Dim LX As Double
Dim e1 As Double
Dim FI As Double
Dim Mf As Double
Dim Bf As Double
Dim Tf As Double
Dim Cf As Double
Dim Nf As Double
Dim Rf As Double
Dim D As Double

Dim RW As Double '纬度
Dim RJ As Double '经度
Dim resultP As PointD
YE = Y
XN = X

e1 = (1 - b / a) / (1 + b / a)
Mf = (XN - FN) / k0
FI = Mf / (a * (1 - e ^ 2 / 4 - 3 * e ^ 4 / 64 - 5 * e ^ 6 / 256))
Bf = FI + (3 * e1 / 2 - 27 * e1 ^ 3 / 32) * Sin(2 * FI) + (21 * e1 ^ 2 / 16 - 55 * e1 ^ 4 / 32) * Sin(4 * FI) + (151 * e1 ^ 3 / 96) * Sin(6 * FI)
Tf = Tan(Bf) ^ 2
Cf = eq ^ 2 * Cos(Bf) ^ 2
Nf = a / Sqr(1 - e ^ 2 * Sin(Bf) ^ 2)
Rf = a * (1 - e ^ 2) / Sqr((1 - e ^ 2 * Sin(Bf) ^ 2) ^ 3)
D = (YE - FE) / (k0 * Nf)

RW = Bf - (Nf * Tan(Bf) / Rf) * (D ^ 2 / 2 - (5 + 3 * Tf + Cf - 9 * Tf * Cf) * D ^ 4 / 24 + (61 + 90 * Tf + 45 * Tf ^ 2) * D ^ 6 / 720)
RJ = L0 + 1 / Cos(Bf) * (D - (1 + 2 * Tf + Cf) * D ^ 3 / 6 + (5 + 28 * Tf + 6 * Cf + 8 * Tf * Cf + 24 * Tf ^ 2) * D ^ 5 / 120)
resultP.X = RW * 180 / PI
resultP.Y = RJ * 180 / PI
GKgetJW = resultP
End Function

转载于:https://www.cnblogs.com/shaoge/archive/2009/08/08/1541928.html

经纬度与高克投影转换代码(VB)相关推荐

  1. 经纬度坐标转换高斯-克吕格平面坐标

    文章目录 前言 主要代码 使用示例 参考链接 原作者链接:https://blog.csdn.net/jianyi7659/article/details/7583339 前言 支持将地理坐标(经纬度 ...

  2. 扎实的基础知识、高质量的代码

    扎实的基础知识.高质量的代码.清晰的思路.优化代码的能力.优秀的综合能力是编程技术面试的五大要点. 找工作一直是一个热门话题.要想找到心仪的工作,难免需要经过多轮面试.编程面试是程序员面试过程中最为重 ...

  3. 经纬度与高斯-克吕格平面坐标转换

    原作者链接:https://blog.csdn.net/jianyi7659/article/details/7583339 前言 支持将地理坐标(经纬度坐标)转换到高斯-克吕格投影下的平面坐标,如北 ...

  4. 写高质量的代码,永不言晚!

    作者 | Nitesh sharma 译者 | 弯月 责编 | 郭芮 出转载自 CSDN(ID:CSDNnews) 以下为译文: 在如今这个时代,每个人都在努力提升资源能力.在Web应用程序方面,我们 ...

  5. 《编写高质量Python代码的59个有效方法》——第10条:尽量用enumerate取代range

    本节书摘来自华章社区<编写高质量Python代码的59个有效方法>一书中的第10条:尽量用enumerate取代range,作者[美]布雷特·斯拉特金(Brett Slatkin),更多章 ...

  6. 表示python代码块的是_编写高质量Python代码的59个有效方法,你用过几个

    欢迎点击右上角关注小编,除了分享技术文章之外还有很多福利,私信学习资料可以领取包括不限于Python实战演练.PDF电子文档.面试集锦.学习资料等. 这个周末断断续续的阅读完了<Effectiv ...

  7. matlab识别图像,基于MATLAB神经网络图像识别的高识别率代码

    MATLAB神经网络图像识别高识别率代码 I0=pretreatment(imread('Z:\data\PictureData\TestCode\SplitDataTest\0 (1).png')) ...

  8. 教你写出可读性高的Python代码

    如果有人问起 Python 程序员他们最喜欢 Python 哪一点,他们一定会提到 Python 的高可读性.确实,对于 Python 来说,其高可读性一直是这门语言设计的核心.一个不争的事实是,相对 ...

  9. iOS 编写高质量Objective-C代码(六)

    级别: ★★☆☆☆ 标签:「iOS」「Block」「Objective-C」 作者: MrLiuQ 审校: QiShare团队 前言: 这几篇文章是小编在钻研<Effective Objecti ...

最新文章

  1. 生物信息行业应该具备哪些基础素养?重点应该放在计算机方面还是生物方面或者说其他?
  2. DAS、NAS和SAN概念与应用的简单比较
  3. Memcached Java客户端编程
  4. 互联网协议入门(二)
  5. mongodb mysql配置_Nosql_MongoDB数据库配置以及基本指令
  6. linux popen管道,linux进程通信之标准流管道popen
  7. NMS 原理和c++实现,已测试通过
  8. 搭建Open××× Server路由模式、证书认证
  9. tp3.2 分析打印查询语句sql
  10. hrbust 哈理工oj 2026 势力较量【并查集】
  11. 向量空间的基和维数例题_线性空间的基和维数
  12. AF(操作者框架)系列(1)-LabVIEW中的模块化应用概述
  13. symbian android,Symbian^3对比
  14. 码破苍穹:空指针的传说
  15. 变焦单目论文阅读笔记
  16. Saltstack自动化运维详解(数据系统 jinja模板 job管理)
  17. 无线WiFi破解教程(转载)
  18. 【Oracle】更新数据表字段值
  19. 计算机网络实验-eNSP路由器配置
  20. Windows Office Word不支持Ctrl多选操作

热门文章

  1. facebook 添加好友_Facebook为您的新闻源和VR添加了250个人的群聊,3D照片
  2. hive之Json解析(普通Json和Json数组)
  3. 厦门理工学院c语言实验循环,厦门理工学院C语言 实验4_循环结构..doc
  4. 读取gb2312编码的xml失败问题分析
  5. 奇特的“对自杀说不”许可证
  6. 沃达丰的云原生之旅:新老结合
  7. cnpm不是内部命令
  8. html css 奥运五环,CSS3 奥运五环加载动画
  9. 计算机应用基础word2010文字处理,计算机应用基础(Word 2010 文字处理系统)
  10. 朋友圈刷屏了!互联网人回乡求生指南