由大地坐标转换为经纬度0

由大地坐标转换为经纬度
Private Sub Form_Paint()'Private ,汉译为私有的,指明本过程只在当前模块下有效Cls '清除显示屏
CurrentX=0 '设置开始的X坐标为零
CurrentY=0 '设置开始的Y坐标为零
Dim dh,dk As Integer
Dim l0,l1,b0,b1,x0,x1,y0,y1,a,f,e,ee,e1,e2,nn,t,c,aa,m,d,r,u,fai,ipl As Double
ipl=3.1415926535898/180
dk=6 '6度带宽
a=6378245.0 '坐标系参数:54北京为6378245.0; 80西安为6378140.0
f=1.0/298.3 ' 坐标系参数:54北京为1.0/298.3; 80西安为1/298.257
x1=2994058
y1=20357237
dh=Int(y1/1000000)
l0=(dh-1)*dk+dk/2
l0=l0*ipl
y0=1000000*dh+500000
x0=0
Print"x1="& x1 & "y1="& y1 & "转换为经纬度"
x1=x1-x0
y1=y1-y0
e2=2*f-f*f
e1=(1-Sqr(1-e2))/(1+Sqr(1-e2))
ee=e2/(1.0-e2)
m=x1
u=m/(a*(1-e2/4-3*e2*e2/64-5*e2*e2/256))
fai=u+(3*e1/2-27*e1*e1*e1/32)*Sin(2*u)+(21*e1*e1/16-55*e1*e1*e1*e1/32)*Sin(4*u) +(151*e1*e1*e1/96)*Sin(6*u)+(1097*e1*e1*e1*e1/512)*Sin(8*u)
c=ee*Cos(fai)*Cos(fai)
t=Tan(fai)*Tan(fai)
nn=a/Sqr(1-e2*Sin(fai)*Sin(fai))
r=a*(1-e1)/Sqr((1-e2*Sin(fai)*Sin(fai))*(1-e2*Sin(fai)*Sin(fai))*(1-e2*Sin(fai)*Sin(fai))) d=y1/nn
'计算经纬度
l1=l0+(d-(1+2*t+c)*d*d*d/6+(5-2*c+28*t-3*c*c+8*ee+24*t*t)*d*d*d*d*d/120)/Cos(fai )
b1=fai-(nn*Tan(fai)/r)*(d*d/2-(5+3*t+10*c-4*c*c-9*ee)*d*d*d*d/24+(61+90*t+298*c+ 45*t*t-256*ee-3*c*c)*d*d*d*d*d*d/720)
'转换为度
l1=l1/ipl
b1=b1/ipl
Print"l1="& l1 & "b1="& b1
End Sub
由经纬度转换为大地坐标
Private Sub Form_Paint()'Private ,汉译为私有的,指明本过程只在当前模块下有效Cls '清除显示屏
CurrentX=0 '设置开始的X坐标为零
CurrentY=0 '设置开始的Y坐标为零
Dim dh,dk As Integer
Dim l0,l1,b0,b1,x0,x1,y0,y1,a,f,e,ee,e2,nn,t,c,aa,m,ipl As Double
ipl=3.14156926535898/180
dk=6 '6度带宽
a=6378245.0 '坐标系参数:54北京为6378245.0; 80西安为6378140.0
f=1.0/298.3 ' 坐标系参数:54北京为1.0/298.3; 80西安为1/298.257
l1=115.5611268
b0=0
b1=27.0502311
dh=Int((l1+6)/6)
l0=(dh-1)*dk+dk/2
l0=l0*ipl
y0=1000000*dh+500000
x0=0
Print"l1="& l1 & "b1="& b1 & "转换为大地坐标"
l1=l1*ipl
b1=b1*ipl
e2=2*f-f*f
ee=e2*(1.0-e2)
nn=a/Sqr(1-e2*Sin(b1)*Sin(b1))
t=Tan(b1)*Tan(b1)
c=ee*Cos(b1)*Cos(b1)
aa=(l1-l0)*Cos(b1)
m=a*((1-e2/4-3*e2*e2/64-5*e2*e2*e2/256)*b1-(3*e2/8+3*e2*e2/32+45*e2*e2*e2/10
24)*Sin(2*b1)+(15*e2*e2/256+45*e2*e2*e2/1024)*Sin(4*b1)-(35*e2*e2*e2/3072)*Sin(6*b1 ))
y1=nn*(aa+(1-t+c)*aa*aa*aa/6+(5-18*t+t*t+72*c-58*ee)*aa*aa*aa*aa*aa/120)
x1=m+nn*Tan(b1)*(aa*aa/2+(5-t+9*c+4*c*c)*aa*aa*aa*aa/24+(61-58*t+t*t+600*c-33 0*ee)*aa*aa*aa*aa*aa*aa/720)
x1=x0+x1
y1=y0+y1
Print"x1="& x1 & "y1="& y1
End Sub。