计算机测绘程序设计代码.docx
《计算机测绘程序设计代码.docx》由会员分享，可在线阅读，更多相关《计算机测绘程序设计代码.docx（15页珍藏版）》请在冰豆网上搜索。
计算机测绘程序设计代码
计算机测绘程序设计实验代码
矩阵运算代码：
OptionBase1
Dima（）AsDouble
Dimb（）AsDouble
Dimc（）AsDouble
PrivateSubCommand1_Click（）
Dimn1AsInteger
Dimm1AsInteger
Dimn2AsInteger
Dimm2AsInteger
Dimmystring（）AsString
Diml（）AsString
mystring（）=Split（Text1.Text,vbCrLf）
m1=UBound（mystring,1）-LBound（mystring,1）
l（）=Split（mystring（0）,""）'第一行数据
n1=UBound（l,1）-LBound（l,1）+1
ReDima（m1,n1）
Fori=1Tom1
l（）=Split（mystring（i-1）,""）
n1=UBound（l,1）-LBound（l,1）+1
Forj=1Ton1
a（i,j）=l（j-1）
Nextj
Nexti
'Dimmystring（）AsString
'Diml（）AsString
mystring（）=Split（Text2.Text,vbCrLf）
m1=UBound（mystring,1）-LBound（mystring,1）
l（）=Split（mystring（0）,""）'第一行数据
n1=UBound（l,1）-LBound（l,1）+1
ReDimb（m1,n1）
Fori=1Tom1
l（）=Split（mystring（i-1）,""）
n1=UBound（l,1）-LBound（l,1）+1
Forj=1Ton1
b（i,j）=l（j-1）
Nextj
Nexti
ReDimc（m1,n1）
Callmadd（a,b,c）
Text3.Text=""
Fori=1Tom1
Forj=1Ton1
Text3.Text=Text3.Text+Str（c（i,j））+""
Nextj
Text3.Text=Text3.Text+vbCrLf
Nexti
EndSub
Submadd（mtxA（）AsDouble,mtxB（）AsDouble,mtxC（）AsDouble）'矩阵相加
DimiAsInteger,jAsInteger
DimmAsInteger,nAsInteger
m=UBound（mtxA,1）-LBound（mtxA,1）+1
n=UBound（mtxA,2）-LBound（mtxA,2）+1
Fori=1Ton
Forj=1Tom
mtxC（i,j）=mtxA（i,j）+mtxB（i,j）
Text3.Text=mtxC（i,j）
Nextj
Nexti
EndSub
角度与弧度的相互转换代码：
PublicFunctionjdzh#（jd#,Optionalsrdw%=0,Optionalscdw%=0）
Constpi#=3.14159265358979
Dimd%,f%,m#,fh%
fh=Sgn（jd）
jd=Abs（jd）
SelectCasesrdw
Case0
d=Int（jd）
f=Int（（jd-d）*100）
m=（（jd-d）*100-f）*100
jdzh=d+f/60+m/3600
Case1
jdzh=jd
CaseElse
jdzh=jd*180/pi
EndSelect
SelectCasescdw
Case0
jdzh=jdzh*pi/180*fh
Case1
jdzh=jdzh*fh
Case2
jdzh=jdzh*60*fh
Case3
jdzh=jdzh*3600*fh
CaseElse
d=Int（jdzh）
f=Int（（jdzh-d）*60）
m=（（jdzh-d）*60-f）*60
jdzh=d+f/100+m/10000*fh
EndSelect
EndFunction
矩阵：
OptionBase1
DimA（）AsDouble
DimB（）AsDouble
DimC（）AsDouble
PrivateSubCommand1_Click（）
Text3.Text=""
DimiAsInteger
DimjAsInteger
Dimn1AsInteger
Dimm1AsInteger
Dimn2AsInteger
Dimm2AsInteger
Dimmystring（）AsString
Diml（）AsString
mystring（）=Split（Text1.Text,vbCrLf）
n1=UBound（mystring,1）-LBound（mystring,1）
l（）=Split（mystring（0）,""）
m1=UBound（l,1）-LBound（l,1）+1
ReDimA（n1,m1）
Fori=1Ton1
l（）=Split（mystring（i-1）,""）
Forj=1Tom1
A（i,j）=l（j-1）
Nextj
Nexti
mystring（）=Split（Text2.Text,vbCrLf）
n2=UBound（mystring,1）-LBound（mystring,1）
l（）=Split（mystring（0）,""）
m2=UBound（l,1）-LBound（l,1）+1
ReDimB（n2,m2）
Fori=1Ton2
l（）=Split（mystring（i-1）,""）
Forj=1Tom2
B（i,j）=l（j-1）
Nextj
Nexti
ReDimC（n1,m1）
Callmadd（A,B,C）
Fori=1Ton2
Forj=1Tom2
Text3.Text=Text3.Text+Str（C（i,j））+""
Nextj
Text3.Text=Text3.Text+vbCrLf
Nexti
EndSub
PrivateSubCommand2_Click（）
Text3.Text=""
Dimmystring（）AsString
Diml（）AsString
mystring（）=Split（Text1.Text,vbCrLf）
n1=UBound（mystring,1）-LBound（mystring,1）
l（）=Split（mystring（0）,""）
m1=UBound（l,1）-LBound（l,1）+1
ReDimA（n1,m1）
Fori=1Ton1
l（）=Split（mystring（i-1）,""）
Forj=1Tom1
A（i,j）=l（j-1）
Nextj
Nexti
mystring（）=Split（Text2.Text,vbCrLf）
n2=UBound（mystring,1）-LBound（mystring,1）
l（）=Split（mystring（0）,""）
m2=UBound（l,1）-LBound（l,1）+1
ReDimB（n2,m2）
Fori=1Ton2
l（）=Split（mystring（i-1）,""）
Forj=1Tom2
B（i,j）=l（j-1）
Nextj
Nexti
ReDimC（n1,m1）
Callmcut（A,B,C）
Fori=1Ton2
Forj=1Tom2
Text3.Text=Text3.Text+Str（C（i,j））+""
Nextj
Text3.Text=Text3.Text+vbCrLf
Nexti
EndSub
PrivateSubCommand3_Click（）
Text3.Text=""
Dimmystring（）AsString
Diml（）AsString
mystring（）=Split（Text1.Text,vbCrLf）
n1=UBound（mystring,1）-LBound（mystring,1）
l（）=Split（mystring（0）,""）
m1=UBound（l,1）-LBound（l,1）+1
ReDimA（n1,m1）
Fori=1Ton1
l（）=Split（mystring（i-1）,""）
Forj=1Tom1
A（i,j）=l（j-1）
Nextj
Nexti
mystring（）=Split（Text2.Text,vbCrLf）
n2=UBound（mystring,1）-LBound（mystring,1）
l（）=Split（mystring（0）,""）
m2=UBound（l,1）-LBound（l,1）+1
ReDimB（n2,m2）
Fori=1Ton2
l（）=Split（mystring（i-1）,""）
Forj=1Tom2
B（i,j）=l（j-1）
Nextj
Nexti
ReDimC（n1,m1）
Callmmul（A,B,C）
Fori=1Ton2
Forj=1Tom2
Text3.Text=Text3.Text+Str（C（i,j））+""
Nextj
Text3.Text=Text3.Text+vbCrLf
Nexti
EndSub
PrivateSubCommand4_Click（）
Text3.Text=""
Dimmystring（）AsString
Diml（）AsString
mystring（）=Split（Text1.Text,vbCrLf）
n1=UBound（mystring,1）-LBound（mystring,1）
l（）=Split（mystring（0）,""）
m1=UBound（l,1）-LBound（l,1）+1
ReDimA（n1,m1）
Fori=1Ton1
l（）=Split（mystring（i-1）,""）
Forj=1Tom1
A（i,j）=l（j-1）
Nextj
Nexti
ReDimC（n1,m1）
CallMRinv（A）
Fori=1Ton1
Forj=1Tom1
Text3.Text=Text3.Text+Str（Format（A（i,j）,"0.0000"））+""
Nextj
Text3.Text=Text3.Text+vbCrLf
Nexti
EndSub
PrivateSubCommand5_Click（）
Text3.Text=""
DimAT（）AsDouble
Dimmystring（）AsString
Diml（）AsString
mystring（）=Split（Text1.Text,vbCrLf）
n1=UBound（mystring,1）-LBound（mystring,1）
l（）=Split（mystring（0）,""）
m1=UBound（l,1）-LBound（l,1）+1
ReDimA（n1,m1）
Fori=1Ton1
l（）=Split（mystring（i-1）,""）
Forj=1Tom1
A（i,j）=l（j-1）
Nextj
Nexti
ReDimAT（m1,n1）
CallMtrans（A,AT）
Fori=1Ton1
Forj=1Tom1
Text3.Text=Text3.Text+Str（Format（AT（i,j）,"0.0000"））+""
Nextj
Text3.Text=Text3.Text+vbCrLf
Nexti
EndSub
Submadd（mtxA（）AsDouble,mtxB（）AsDouble,mtxC（）AsDouble）'矩阵相加
DimiAsInteger,jAsInteger
DimmAsInteger,nAsInteger
m=UBound（mtxA,1）-LBound（mtxA,1）+1
n=UBound（mtxA,2）-LBound（mtxA,2）+1
Fori=1Ton
Forj=1Tom
mtxC（i,j）=mtxA（i,j）+mtxB（i,j）
Nextj
Nexti
EndSub
Submcut（mtxA（）AsDouble,mtxB（）AsDouble,mtxC（）AsDouble）'矩阵相减
DimiAsInteger,jAsInteger
DimmAsInteger,nAsInteger
m=UBound（mtxA,1）-LBound（mtxA,1）+1
n=UBound（mtxA,2）-LBound（mtxA,2）+1
Fori=1Ton
Forj=1Tom
mtxC（i,j）=mtxA（i,j）-mtxB（i,j）
Nextj
Nexti
EndSub
SubMtrans（mtxA（）AsDouble,mtxAT（）AsDouble）'矩阵转置
DimiAsInteger,jAsInteger
DimmAsInteger,nAsInteger
m=UBound（mtxA,1）-LBound（mtxA,1）+1
n=UBound（mtxA,2）-LBound（mtxA,2）+1
Fori=1Ton
Forj=1Tom
mtxAT（i,j）=mtxA（j,i）
Nextj
Nexti
EndSub
Submmul（mtxA（）AsDouble,mtxB（）AsDouble,mtxC（）AsDouble）'矩阵相乘
DimmAsInteger
DimnAsInteger
DimlAsInteger
DimiAsInteger,jAsInteger,KAsInteger
m=UBound（mtxA,1）-LBound（mtxA,1）+1
n=UBound（mtxA,2）-LBound（mtxA,2）+1
l=UBound（mtxB,2）-LBound（mtxB,2）+1
Fori=1Tom
Forj=1Tol
mtxC（i,j）=0#
ForK=1Ton
mtxC（i,j）=mtxC（i,j）+mtxA（i,K）*mtxB（K,j）
NextK
Nextj
Nexti
EndSub
FunctionMRinv（mtxA（）AsDouble）AsBoolean'矩阵求逆
DimnAsInteger
n=UBound（mtxA,1）-LBound（mtxA,1）+1
ReDimnIs（0Ton）AsInteger,nJs（0Ton）AsInteger
DimiAsInteger,jAsInteger,KAsInteger
DimDAsDouble,pAsDouble
ForK=1Ton
D=0#
Fori=KTon
Forj=KTon
p=Abs（mtxA（i,j））
If（p>D）Then
D=p
nIs（K）=i
nJs（K）=j
EndIf
Nextj
Nexti
If（D+1#=1#）Then
MRinv=False
ExitFunction
EndIf
If（nIs（K）<>K）Then
Forj=1Ton
p=mtxA（K,j）
mtxA（K,j）=mtxA（nIs（K）,j）
mtxA（nIs（K）,j）=p
Nextj
EndIf
If（nJs（K）<>K）Then
Fori=1Ton
p=mtxA（i,K）
mtxA（i,K）=mtxA（i,nJs（K））
mtxA（i,nJs（K））=p
Nexti
EndIf
mtxA（K,K）=1#/mtxA（K,K）
Forj=1Ton
If（j<>K）ThenmtxA（K,j）=mtxA（K,j）*mtxA（K,K）
Nextj
Fori=1Ton
If（i<>K）Then
Forj=1Ton
If（j<>K）ThenmtxA（i,j）=mtxA（i,j）-mtxA（i,K）*mtxA（K,j）
Nextj
EndIf
Nexti
Fori=1Ton
If（i<>K）ThenmtxA（i,K）=-mtxA（i,K）*mtxA（K,K）
Nexti
NextK
ForK=nTo1Step-1
If（nJs（K）<>K）Then
Forj=1Ton
p=mtxA（K,j）
mtxA（K,j）=mtxA（nJs（K）,j）
mtxA（nJs（K）,j）=p
Nextj
EndIf
If（nIs（K）<>K）Then
Fori=1Ton
p=mtxA（i,K）
mtxA（i,K）=mtxA（i,nIs（K））
mtxA（i,nIs（K））=p
Nexti
EndIf
NextK
MRinv=True
EndFunction
升级会员 