高斯投影坐标正反算及相邻带的坐标换算VB编程Word文件下载.docx

高斯投影坐标正反算及相邻带的坐标换算VB编程Word文件下载.docx

《高斯投影坐标正反算及相邻带的坐标换算VB编程Word文件下载.docx》由会员分享，可在线阅读，更多相关《高斯投影坐标正反算及相邻带的坐标换算VB编程Word文件下载.docx（13页珍藏版）》请在冰豆网上搜索。

Then

OpenText4.TextForInputAs#1'

*****读入数据'

DoWhileNotEOF

（1）

Input#1,h,k,s

List1.AddItemh

List2.AddItemk

List3.AddItems

Loop

Close#1

Else

Style=vbExclamation+vbOKOnly

r=MsgBox（"

没有指定路径"

Style,"

错误提示"

）

EndIf

PrivateSubCommand3_Click（）

IfList1.ListCount=0OrList2.ListCount=0OrList3.ListCount=0Then'

*******主过程'

没有找到数据"

IfOption1.Value=FalseAndOption2.Value=FalseAndOption3.Value=FalseThen

没有选择椭球"

Else

Open"

d:

\正算结果.txt"

ForOutputAs#1

Print#1,"

X"

&

Chr（44）;

Spc（18）;

Y"

Spc（24）;

r0"

Close#1

Dimx1#,p#,r0#,t#,w2#,v2#,N#,l0#,p0#,t2#,p2#,rr$,x#,y#,b#,j#,j0#,B0#'

********正算'

Fori=0ToList1.ListCount-1

b=fd（Val（List1.List（i）））

B0=b*p0

j=fd（Val（List2.List（i）））

j0=fd（Val（List3.List（i）））

t=Tan（b）

w2=ee1*（Cos（b））^2

N=c/Sqr（1+w2）

l0=j-j0

x1=a0*B0+a2*Sin（2*b）+a4*Sin（4*b）+a6*Sin（6*b）+a8*Sin（8*b）

p=Cos（b）*l0/p0

t2=t^2

p2=p^2

s1#=（9+4*w2）*w2

s2#=（t2-58）*t2

s3#=（9-11*t2）*30*w2

s4#=（543-t2）*t2

x=x1+N*t*（1+（（5-t2+s1）+（（61+s2+s3）+（1385+（-3111+s4）*t2）*p2/56）*p2/30）*p2/12）*p2/2

m1#=1-t2+w2

m2#=t2*（t2-18-58*w2）

m3=（179-t2）*t2

y=N*（1+（m1+（（5+m2+14*w2）+（61+（-479+m3）*t2）*p2/42）*p2/20）*p2/6）*p

k1#=w2*（3+2*w2）

k2#=15*w2*（1-t^3）

k3#=2*（t2-13）*t2

r0=（Sin（b）*l0*（1+（（1+k1）+（（2-t2+k2）+（17+k3）*p2/21）*p2/5）*p2/3））*p0

Ifr0>

0Then

rr=Fix（r0）&

°

Fix（（r0-Fix（r0））*60）&

'

（（r0-Fix（r0））*60-Fix（（r0-Fix（r0））*60））*60

r0=-r0

rr="

-"

Fix（r0）&

EndIf

List4.AddItemx

List5.AddItemy

List6.AddItemrr

Dimh#,k#,s$

ForAppendAs#1

h=List4.List（i）:

k=List5.List（i）:

s=List6.List（i）

Print#1,h&

Spc（3）;

k&

Spc（9）;

s

Next

已输出正算结果到D：

\目录下"

提示"

PrivateSubCommand4_Click（）

IfList4.ListCount=0OrList5.ListCount=0Then'

\反算结果.txt"

经度"

Spc（17）;

维度"

Spc（23）;

DimB0#,Bf#,Bf0#,b#,l0#,r0#,wf2#,tf#,Nf#,q#,y0#,x0#,p0#,tf2#,q2#,Bf1#,L#'

********反算'

Fori=0ToList4.ListCount-1

y0=Val（List5.List（i））

x0=Val（List4.List（i））

L=Val（List3.List（i））

B0=x0*q0

Bf=B0+Sin（2*B0）*q2+Sin（2*B0）*Sin（B0）^2*（q4+Sin（B0）^2*q6+（Sin（B0）^2）^2*q8）

Bf0=Bf*p0

tf=Tan（Bf）

wf2=ee1*Cos（Bf）^2

vf2=1+wf2

Nf=c/Sqr（vf2）

q=y0/Nf

tf2=tf^2

q2=q^2

b=Bf0+p0*tf*（-vf2+（（5+3*tf2*（1+（-2-3*wf2）*wf2）+3*wf2*（2-wf2））+（-（61+45*tf2*（2+tf2）+（107+（-162-45*tf2）*tf2）*wf2）+（1385+（3633+（4095+1575*tf2）*tf2）*tf2）*q2/56）*q2/30）*q2/12）*q2/2

k1#=1+2*tf2+wf2

k2#=4*tf2*（7+6*tf2）

k3#=2*wf2*（3+4*tf2）

k4#=（1320+720*tf2）*tf2

l0=p0*q/Cos（Bf）*（1+（-k1+（（5+k2+k3）-（61+（662+k4）*tf2）*q2/42）*q2/20）*q2/6）+L

m1#=wf2*（1+2*wf2）

m2#=tf2*（5+3*tf2）

m3#=wf2*（2+tf2）

m4#=（105+45*tf2）*tf2

r0=p0*q*tf*（1+（-（1+tf2-m1）+（（2+m2+m3）-（17+（77+m4）*tf2）*q2/21）*q2/5）*q2/3）

List1.AddItemb

List2.AddIteml0

List6.AddItemr0

已输出反算结果到D:

PrivateSubCommand5_Click（）

Form2.Hide

Form1.Show

PrivateSubLabel8_Click（）

PrivateSubCommand6_Click（）

UnloadMe

LoadMe

Me.Show

LoadMe

PrivateSubCommand7_Click（）

*****读入数据‘

List4.AddItemh

List5.AddItemk

PrivateSubOption1_Click（）

a=6378245'

******克氏椭球'

c=6399698.90178271

ee1=6.738525414683*10^-3

ee=6.693421622966*10^-3

a0=111134.8610828

a2=-16036.48022

a4=16.82805

a6=-2.197*10^-2

a8=3*10^-5

q0=157046064.12328*10^-15

q2=2525886946.8158*10^-12

q4=-14919317.6572*10^-12

q6=120717.4265*10^-12

q8=-1075.1509*10^-12

PrivateSubOption2_Click（）

a=6378140'

******1975椭球'

c=6399596.65198801

ee1=6.739501819473*10^-3

ee=6.694384999588*10^-3

a0=111134.0046793

a2=-16038.52818

a4=16.83263

a6=-2.198*10^-2

q0=157048687.47416*10^-15

q2=2526252791.9786*10^-12

q4=-14923644.4356*10^-12

q6=120769.9608*10^-12

q8=-1075.77*10^-12

PrivateSubOption3_Click（）

a=6378137'

******84椭球'

c=6399593.6258

ee1=6.73949674227*10^-3

ee=6.694799013*10^-3

a0=111132.9525494

a2=-16038.5084

a4=16.8326

q0=157048761.142065*10^-15

q2=2526250855.8867*10^-12

q4=-14923621.5362*10^-12

q6=120769.6828*10^-12

q8=-1075.7667*10^-12

IfOption1.Value=FalseAndOption2.Value=FalseAndOption3.Value=FalseThen

r=MsgBox（"

请选择椭球参数"

vbExclamation+vbOKOnly,"

IfText1.Text="

OrText2.Text="

OrText3.Text&

Text4.Text&

Text5.Text="

OrText6.Text&

Text7.Text&

Text8.Text="

没有数据或数据不完整"

Dimx,y,x1,x2,y2,p°

B°

l2°

l°

L,L1,L2,c′,e′,tf,tf2,wf,wf2,Vf,Nf,q,q2,B0,Bf,Bf°

g,h,i,a,b,cAsDouble

g=Val（Text3.Text）:

h=Val（Text4.Text）:

i=Val（Text5.Text）

a=Val（Text6.Text）:

b=Val（Text7.Text）:

c=Val（Text8.Text）

p°

=57.2957795130823

L1=（g+h/60+i/3600）/p°

L2=（a+b/60+c/3600）/p°

x=Val（Text1.Text）:

y=Val（Text2.Text）

IfOption1.Value=TrueAndOption2.Value=FalseAndOption3.Value=FalseThen

B0=157046064.12328*10^（-15）*x

Bf=B0+Sin（2*B0）*2525886946.8158*10^（-12）+Sin（2*B0）*（Sin（B0））^2*（-14919317.6572*10^（-12）+（Sin（B0））^2*（120717.4265*10^（-12）-1075.1509*10^（-12）*（Sin（B0））^2））

Bf°

=Bf*p°

e′=Sqr（6.738525414683*10^-3）

c′=6399698.90178271

tf=Tan（Bf）:

tf2=tf^2:

wf=e′*Cos（Bf）:

wf2=wf^2:

Vf=Sqr（1+wf^2）:

Nf=c′/Vf

q=y/Nf

B°

=Bf°

+p°

*tf*（-Vf^2+（（5+3*tf2*（1+（-2-3*wf2）*wf2）+3*wf2*（2-wf2））+（-（61+45*tf2*（2+tf2）+（107+（-162-45*tf2）*tf2）*wf2）+（1385+（3633+（4095+1575*tf2）*tf2）*tf2）*q^2/56）*q^2/30）*q^2/12）*q^2/2

l2°

=p°

*q/Cos（Bf）*（1+（-（1+2*tf2+wf2）+（（5+4*tf2*（7+6*tf2）+2*wf2*（3+4*tf2））-（61+（662+（1320+720*tf2）*tf2）*tf2）*q^2/42）*q^2/20）*q^2/6）

L=L1+l2°

t=Tan（B°

/p°

）:

t2=t^2:

l°

=L-L2

p=Cos（B°

）*l°

p2=p^2

w=（e′*Cos（B°

））:

w2=w^2:

V=Sqr（1+w^2）:

N=c′/V

x1=111134.8610828*B°

-16036.48022*Sin（2*B°

）+16.82805*Sin（4*B°

）-0.02197*Sin（6*B°

）+0.00003*Sin（8*B°

x2=x1+N*t*（1+（（5-t2+（9+4*w2）*w2）+（（61+（t2-58）*t2+（9-11*t2）*30*w2）+（1385+（-3111+（543-t2）*t2）*t2）*p2/56）*p2/30）*p2/12）*p2/2

y2=N*（1+（（1-t2+w2）+（（5+t2*（t2-18-58*w2）+14*w2）+（61+（-479+（179-t2）*t2）*t2）*p2/42）*p2/20）*p2/6）*p

IfOption1.Value=FalseAndOption2.Value=TrueAndOption3.Value=FalseThen

B0=157048687.47416*10^（-15）*x

Bf=B0+Sin（2*B0）*2526252791.9786*10^（-12）+Sin（2*B0）*（Sin（B0））^2*（-14923644.4356*10^（-12）+（Sin（B0））^2*（120769.9608*10^（-12）-1075.77*10^（-12）*（Sin（B0））^2））

e′=Sqr（6.739501819473*10^-3）

c′=6399596.65198801

w