高斯投影坐标正反算及相邻带的坐标换算VB编程.docx
《高斯投影坐标正反算及相邻带的坐标换算VB编程.docx》由会员分享，可在线阅读，更多相关《高斯投影坐标正反算及相邻带的坐标换算VB编程.docx（13页珍藏版）》请在冰豆网上搜索。
高斯投影坐标正反算及相邻带的坐标换算VB编程
高斯投影坐标正反算及相邻带的坐标换算VB编程
PrivateSubCommand1_Click（）
Form1.Hide
Form2.Show
EndSub
PrivateSubCommand2_Click（）
Form1.Hide
Form3.Show
EndSub
Publica#,c#,ee1#,ee#,a0#,a2#,a4#,a6#,a8#,q0#,q2#,q4#,q6#,q8#,p0#
PublicFunctionfd（ByValgAsDouble）AsDouble
DimmmAsDouble,dd&,ii&
p0=57.2957795513082
g=g+1E-19'*******弧度转换'
dd=Fix（g）
ii=Fix（（g-dd）*100）
mm=（g-dd）*100-ii
mm=dd+ii/60+mm/36
fd=mm/p0
EndFunction
PrivateSubCommand1_Click（）
DimaAsString
CommonDialog1.ShowOpen'*******查找路径'
Text4.Text=CommonDialog1.FileName
EndSub
PrivateSubCommand2_Click（）
Dimh#,k#,s#
IfText4.Text<>""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
EndSub
PrivateSubCommand3_Click（）
IfList1.ListCount=0OrList2.ListCount=0OrList3.ListCount=0Then'*******主过程'
Style=vbExclamation+vbOKOnly
r=MsgBox（"没有找到数据",Style,"错误提示"）
Else
IfOption1.Value=FalseAndOption2.Value=FalseAndOption3.Value=FalseThen
Style=vbExclamation+vbOKOnly
r=MsgBox（"没有选择椭球",Style,"错误提示"）
Else
Open"d:
\正算结果.txt"ForOutputAs#1
Print#1,"X"&Chr（44）;Spc（18）;"Y"&Chr（44）;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
p0=57.2957795513082
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
Else
r0=-r0
rr="-"&Fix（r0）&"°"&Fix（（r0-Fix（r0））*60）&"'"&（（r0-Fix（r0））*60-Fix（（r0-Fix（r0））*60））*60
EndIf
List4.AddItemx
List5.AddItemy
List6.AddItemrr
Dimh#,k#,s$
Open"d:
\正算结果.txt"ForAppendAs#1
h=List4.List（i）:
k=List5.List（i）:
s=List6.List（i）
Print#1,h&Chr（44）;Spc（3）;k&Chr（44）;Spc（9）;s
Close#1
Next
Style=vbExclamation+vbOKOnly
r=MsgBox（"已输出正算结果到D：
\目录下",Style,"提示"）
EndIf
EndIf
EndSub
PrivateSubCommand4_Click（）
IfList4.ListCount=0OrList5.ListCount=0Then'*******主过程'
Style=vbExclamation+vbOKOnly
r=MsgBox（"没有找到数据",Style,"错误提示"）
Else
IfOption1.Value=FalseAndOption2.Value=FalseAndOption3.Value=FalseThen
Style=vbExclamation+vbOKOnly
r=MsgBox（"没有选择椭球",Style,"错误提示"）
Else
Open"d:
\反算结果.txt"ForOutputAs#1
Print#1,"经度"&Chr（44）;Spc（17）;"维度"&Chr（44）;Spc（23）;"r0"
Close#1
DimB0#,Bf#,Bf0#,b#,l0#,r0#,wf2#,tf#,Nf#,q#,y0#,x0#,p0#,tf2#,q2#,Bf1#,L#'********反算'
Fori=0ToList4.ListCount-1
p0=57.2957795513082
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
Ifr0>0Then
rr=Fix（r0）&"°"&Fix（（r0-Fix（r0））*60）&"'"&（（r0-Fix（r0））*60-Fix（（r0-Fix（r0））*60））*60
Else
r0=-r0
rr="-"&Fix（r0）&"°"&Fix（（r0-Fix（r0））*60）&"'"&（（r0-Fix（r0））*60-Fix（（r0-Fix（r0））*60））*60
EndIf
Dimh#,k#,s$
Open"d:
\反算结果.txt"ForAppendAs#1
h=List4.List（i）:
k=List5.List（i）:
s=List6.List（i）
Print#1,h&Chr（44）;Spc（3）;k&Chr（44）;Spc（9）;s
Close#1
Next
Style=vbExclamation+vbOKOnly
r=MsgBox（"已输出反算结果到D:
\目录下",Style,"提示"）
EndIf
EndIf
EndSub
PrivateSubCommand5_Click（）
Form2.Hide
Form1.Show
EndSub
PrivateSubLabel8_Click（）
EndSub
PrivateSubCommand6_Click（）
UnloadMe
LoadMe
Me.Show
LoadMe
EndSub
PrivateSubCommand7_Click（）
Dimh#,k#,s#
IfText4.Text<>""Then
OpenText4.TextForInputAs#1'*****读入数据‘
DoWhileNotEOF
（1）
Input#1,h,k,s
List4.AddItemh
List5.AddItemk
List3.AddItems
Loop
Close#1
Else
Style=vbExclamation+vbOKOnly
r=MsgBox（"没有指定路径",Style,"错误提示"）
EndIf
EndSub
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
EndSub
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
a8=3*10^-5
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
EndSub
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
a6=-2.198*10^-2
a8=3*10^-5
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
EndSub
PrivateSubCommand1_Click（）
IfOption1.Value=FalseAndOption2.Value=FalseAndOption3.Value=FalseThen
r=MsgBox（"请选择椭球参数",vbExclamation+vbOKOnly,"提示"）
EndIf
IfText1.Text=""OrText2.Text=""OrText3.Text&Text4.Text&Text5.Text=""OrText6.Text&Text7.Text&Text8.Text=""Then
r=MsgBox（"没有数据或数据不完整",vbExclamation+vbOKOnly,"提示"）
Else
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°/p°）*l°/p°
p2=p^2
w=（e′*Cos（B°/p°））:
w2=w^2:
V=Sqr（1+w^2）:
N=c′/V
x1=111134.8610828*B°-16036.48022*Sin（2*B°/p°）+16.82805*Sin（4*B°/p°）-0.02197*Sin（6*B°/p°）+0.00003*Sin（8*B°/p°）
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
EndIf
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））
Bf°=Bf*p°
e′=Sqr（6.739501819473*10^-3）
c′=6399596.65198801
tf=Tan（Bf）:
tf2=tf^2:
w
升级会员 