平差程序核心代码VBWord文档格式.docx
- 文档编号:17606804
- 上传时间:2022-12-07
- 格式:DOCX
- 页数:19
- 大小:17.86KB
平差程序核心代码VBWord文档格式.docx
《平差程序核心代码VBWord文档格式.docx》由会员分享,可在线阅读,更多相关《平差程序核心代码VBWord文档格式.docx(19页珍藏版)》请在冰豆网上搜索。
IfdetX<
DirectAB=PI+DirectAB
ElseIfdetX>
0AnddetY<
DirectAB=PI*2+DirectAB
EndFunction
弧度化为度.分秒的形式:
输入弧度值,输出度.分秒(各占两位)
PublicFunctionHuToDo(ByValHuAsDouble)AsSingle
Dimdu%,fen%,miao%
Hu=Hu*180/PI
du=Fix(Hu)
Hu=(Hu-du)*60
fen=Fix(Hu)
Hu=(Hu-fen)*60
miao=Fix(Hu+0.5)
Ifmiao=60Then
fen=fen+1
miao=0
Iffen=60Then
du=du+1
fen=0
HuToDo=du+fen/100+miao/10000
将度.分秒形式化为弧度:
输入为度.分秒形式,输出为弧度
PublicFunctionDoToHu(ByValDoFenMiaoAsDouble)AsSingle
Dimdu%,fen%,miao%,angle#
du=Fix(DoFenMiao)
DoFenMiao=(DoFenMiao-du)*100
fen=Fix(DoFenMiao)
miao=(DoFenMiao-fen)*100
angle=du+fen/60+miao/3600
DoToHu=angle*PI/180
矩阵转置的通用过程
PublicSubMatrixTrans(A,c)
Dimi%,j%
DimR1%,C1%
OnErrorResumeNext
C1=UBound(A,2)-LBound(A,2)+1
IfErrThen
MsgBox"
输入的矩阵维数不对!
"
ExitSub
R1=UBound(A,1)-LBound(A,1)+1
ReDimc(1ToC1,1ToR1)
Fori=1ToR1
Forj=1ToC1
c(j,i)=A(i,j)
Nextj
Nexti
EndSub
矩阵相加的通用过程
PublicSubMatrixPlus(A,b,c)
DimR1%,C1%,R2%,C2%
第一个矩阵维数不对!
C2=UBound(b,2)-LBound(b,2)+1
第二个矩阵维数不对!
R2=UBound(b,1)-LBound(b,1)+1
IfR1<
>
R2OrC1<
C2Then
输入的两个矩阵维数不等,不能相加!
ReDimc(1Tom,1Ton)AsDouble
Fori=1Tom
Forj=1Ton
c(i,j)=A(i,j)+b(i,j)
矩阵相减的通用过程
PublicSubMatrixMinus(A,b,c)
输入的两个矩阵维数不等,不能相减!
c(i,j)=A(i,j)-b(i,j)
矩阵相乘:
输入矩阵或数Qa、Qb,自动识别它们的维数,并输出它们的乘积Qn
PublicSubMatrix_Multy(Qn,Qa,Qb)
Dimia%,ib%,ic%
Dimai%,bi%,ci%
Dime1AsBoolean,e2AsBoolean,e3AsBoolean,e4AsBoolean,e5AsBoolean,e6AsBoolean,e7AsBoolean
OnErrorResumeNext'
看Qa是不是一维数组
ic=UBound(Qa,2)-LBound(Qa,2)
IfErrThene1=True
ib=UBound(Qb,2)-LBound(Qb,2)
IfErrThene2=True
Ife1=FalseAnde2=FalseThen'
二维矩阵相乘
Forai=LBound(Qa,1)ToUBound(Qa,1)
Forbi=LBound(Qb,2)ToUBound(Qb,2)
Forci=LBound(Qa,2)ToUBound(Qa,2)
Qn(ai,bi)=Qn(ai,bi)+Qa(ai,ci)*Qb(ci,bi)
Nextci
Nextbi
Nextai
ElseIfe1=TrueAnde2=FalseThen
ia=UBound(Qa)-LBound(Qa)
IfErrThene6=True
Ife6Then'
数乘以二维矩阵
Forai=LBound(Qb,1)ToUBound(Qb,1)
Qn(ai,bi)=Qa*Qb(ai,bi)
Else'
一维矩阵乘以二维矩阵
Forci=LBound(Qb,2)ToUBound(Qb,2)
Qn(ci)=Qn(ci)+Qa(ai)*Qb(ai,ci)
ElseIfe1=FalseAnde2=TrueThen
ic=UBound(Qb)-LBound(Qb)
IfErrThene7=True
Ife7Then'
二维矩阵乘以数
Forbi=LBound(Qa,2)ToUBound(Qa,2)
Qn(ai,bi)=Qa(ai,bi)*Qb
二维矩阵乘以一维矩阵
Qn(ai)=Qn(ai)+Qa(ai,bi)*Qb(bi)
DimerrTAsInteger
结果是否是一个数
errT=UBound(Qn)
IfErrThene3=True
Ife3Then'
一维矩阵乘以一维矩阵得一个数
Qn=Qn+Qa(ai)*Qb(bi)
是否是数乘一维矩阵
IfErrThene4=True
Ife4Then
Qn(bi)=Qa*Qb(bi)
是否是一维矩阵乘数
ib=UBound(Qb)-LBound(Qb)
IfErrThene5=True
Ife5Then
Qn(ai)=Qa(ai)*Qb
'
一维矩阵相乘结果是二维矩阵
Qn(ai,bi)=Qa(ai)*Qb(bi)
矩阵相乘的通用过程
PublicSubMatrixMulti(A,b,c)
Dimi%,j%,K%
IfC1<
R2Then
输入的两个矩阵大小不对,不能相乘!
m=R1:
s=C1:
n=C2
ForK=1Tos
c(i,j)=c(i,j)+A(i,K)*b(K,j)
NextK
列选主元法Guass约化求解线性方程组
PublicSubMajorInColGuass(A,b,X)
DimRow%,Col%,n%
矩阵大小
DimiStep%,iRow%,iCol%
循环变量
DimL()AsDouble
各行的约化系数
计算并检查矩阵的大小
Row=UBound(A,1)-LBound(A,1)+1
Col=UBound(A,2)-LBound(A,2)+1
IfRow<
ColThen
方程组的系数矩阵有误!
准备约化过程的变量和数组
n=UBound(b)-LBound(b)+1
Ifn<
RowThen
方程组的系数矩阵与常数项大小不符!
ReDimL(2ToRow)AsDouble
DimsumAXAsDouble,iPos%,temp#
约化过程
ForiStep=1Ton-1
列选主元
iPos=0
ForiRow=iStep+1Ton
IfAbs(A(iRow,iStep))>
Abs(A(iStep,iStep))Then
iPos=iRow
NextiRow
IfiPos>
iStepThen
需要换主元
ForiCol=iStepTon
temp=A(iStep,iCol)
A(iStep,iCol)=A(iPos,iCol)
A(iPos,iCol)=temp
NextiCol
temp=b(iStep)
b(iStep)=b(iPos)
b(iPos)=temp
L(iRow)=A(iRow,iStep)/A(iStep,iStep)
A(iRow,iCol)=A(iRow,iCol)-L(iRow)*A(iStep,iCol)
b(iRow)=b(iRow)-L(iRow)*b(iStep)
ShowMatrixA
NextiStep
回代过程
X(n)=b(n)/A(n,n)
ForiRow=n-1To1Step-1
sumAX=0
ForiCol=nToiRow+1Step-1
sumAX=sumAX+A(iRow,iCol)*X(iCol)
X(iRow)=(b(iRow)-sumAX)/A(iRow,iRow)
Guass-Seidel迭代法求解线性方程组
PrivateFunctionSeidel(A,b,X,eps#)AsBoolean
DimP#,Q#,s#,t#
DimRow%,Col%,n%
ExitFunction
Fori=1Ton
P=0#
X(i)=0#
Ifi<
jThenP=P+Abs(A(i,j))
IfP>
=Abs(A(i,i))Then
Seidel=False
P=eps+1#
WhileP>
=eps
t=X(i)
s=0#
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 程序 核心 代码 VB