VB坐标转换程序设计.docx
- 文档编号:10660642
- 上传时间:2023-05-27
- 格式:DOCX
- 页数:32
- 大小:63.82KB
VB坐标转换程序设计.docx
《VB坐标转换程序设计.docx》由会员分享,可在线阅读,更多相关《VB坐标转换程序设计.docx(32页珍藏版)》请在冰点文库上搜索。
VB坐标转换程序设计
OptionExplicit
Dimk2#,e2#,dX2#,dY2#
Dimx2#,Xx2#,y2#,Yy2#
Dimk3#,Ex#,Ey#,Ez#,dX3#,dY3#,dZ3#
DimX3#,Y3#,Z3#,Xx3#,Yy3#,Zz3#
ConstPI=
PrivateSubCheck1_Click()
If=1Then
=5175
ElseIf=0Then
=4440
EndIf
EndSub
PrivateSubcmdBrowFile_Click()
="操纵点文件(*.gcp)|*.gcp|所有文件(*.*)|*.*"
=1
=
EndSub
PrivateSubcmdCalc_Click()
DimsAsString,iPos%,i%,iCent!
Dimn%,x1#(),y1#(),x2#(),y2#()
DimA()AsDouble,L()AsDouble,x(1To4)AsDouble
DimAt#(),Naa#(),W#()
OpenForInputAs#1
LineInput#1,s
n=Val(s)
ReDimx1#(n),y1#(n),x2#(n),y2#(n)
Fori=1Ton
LineInput#1,s
iPos=InStr(s,",")
x1(i)=Val(Left(s,iPos-1))
s=Mid(s,iPos+1)
iPos=InStr(s,",")
y1(i)=Val(Left(s,iPos-1))
s=Mid(s,iPos+1)
iPos=InStr(s,",")
x2(i)=Val(Left(s,iPos-1))
s=Mid(s,iPos+1)
y2(i)=Val(s)
Nexti
Close#1
'计算转换参数
ReDimA(1To2*n,1To4)AsDouble,L(1To2*n)AsDouble
ReDimAt(1To4,1To2*n),Naa(1To4,1To4),W(1To4)
"系数矩阵A:
"
Fori=1Ton
A(2*i-1,1)=1:
A(2*i-1,2)=0:
A(2*i-1,3)=x1(i):
A(2*i-1,4)=y1(i)
A(2*i-1,1),A(2*i-1,2),A(2*i-1,3),A(2*i-1,4)
A(2*i,1)=0:
A(2*i,2)=1:
A(2*i,3)=y1(i):
A(2*i,4)=-x1(i)
A(2*i,1),A(2*i,2),A(2*i,3),A(2*i,4)
L(2*i-1)=x2(i):
L(2*i)=y2(i)
Nexti
"常数向量L:
"
Fori=1To2*n
L(i)
Nexti
MatrixTransA,At
"A的转置矩阵:
"
ShowMatrixAt
Matrix_MultyNaa,At,A
"Naa:
"
ShowMatrixNaa
Matrix_MultyW,At,L
"W:
"
Fori=1To4
W(i)
Nexti
MajorInColGuassNaa,W,x
"X"
Fori=1To4
x(i)
Nexti
'分离旋转和尺度参数
IfAbs(x(3)) Ifx(4)>0Then e2=PI/2 Else e2=PI*3/2 EndIf Else e2=Atn(x(4)/x(3))'取得的是弧度 Ifx(3)<0Andx(4)>0Then e2=PI-e2 ElseIfx(3)<0Andx(4)<0Then e2=PI+e2 ElseIfx(3)>0Andx(4)<0Then e2=PI*2+e2 EndIf EndIf k2=x(3)/Cos(e2) '将转换参数写入相应文本框 txtK2=Str(k2-1) e2=e2*180/PI Dimdu%,fen% du=Int(e2): e2=(e2-du)*60 fen=Int(e2): e2=(e2-fen)*60 e2=Val(Format(e2,"")) e2=du+fen/100#+e2/10000 txtE2=Str(e2) =Str(x (1)) =Str(x (2)) EndSub PrivateSubcmdCalc2_Click() k2=Val e2=Val e2=DoToHu(e2) dX2=Val dY2=Val x2=Val y2=Val Xx2=(k2+1)*(x2*Cos(e2)+y2*Sin(e2))+dX2 Yy2=(k2+1)*(y2*Cos(e2)-x2*Sin(e2))+dY2 =Format(Xx2,"") =Format(Yy2,"") EndSub PrivateSubcmdCalc3_Click() k3=Val Ex=Val Ex=DoToHu(Ex) Ey=Val Ey=DoToHu(Ey) Ez=Val Ez=DoToHu(Ez) dX3=Val dY3=Val dZ3=Val X3=Val Y3=Val Z3=Val Xx3=(k3+1)*(X3*Cos(Ey)*Cos(Ez)+Y3*Cos(Ey)*Sin(Ez)-Z3*Sin(Ey))+dX3 Yy3=(k3+1)*(X3*(-Cos(Ex)*Sin(Ez)+Sin(Ex)*Sin(Ey)*Cos(Ez))+Y3*(Cos(Ex)*Cos(Ez)+Sin(Ex)*Sin(Ey)*Sin(Ez))+Z3*(Sin(Ex)*Cos(Ey)))+dY3 Zz3=(k3+1)*(X3*(Sin(Ex)*Sin(Ez)+Cos(Ex)*Sin(Ey)*Cos(Ez))+Y3*(-Sin(Ex)*Cos(Ez)+Cos(Ex)*Sin(Ey)*Sin(Ez))+Z3*(Cos(Ex)*Cos(Ey)))+dZ3 =Format(Xx3,"") =Format(Yy3,"") =Format(Zz3,"") EndSub PrivateSubcmdClear2_Click() ="" ="" ="" ="" EndSub PrivateSubcmdClear3_Click() ="" ="" ="" ="" ="" ="" EndSub PrivateSubcmdconCalc2_Click() k2=Val e2=Val e2=DoToHu(e2) dX2=Val dY2=Val Xx2=Val Yy2=Val x2=((Xx2-dX2)*Cos(e2)-(Yy2-dY2)*Sin(e2))/(k2+1) y2=((Yy2-dY2)*Cos(e2)+(Xx2-dX2)*Sin(e2))/(k2+1) =Format(x2,"") =Format(y2,"") EndSub PrivateSubcmdconCalc3_Click() k3=Val Ex=Val Ex=DoToHu(Ex) Ey=Val Ey=DoToHu(Ey) Ez=Val Ez=DoToHu(Ez) dX3=Val dY3=Val dZ3=Val Xx3=Val Yy3=Val Zz3=Val X3=((Xx3-dX3)*Cos(Ey)*Cos(Ez)+(Yy3-dY3)*(-Cos(Ex)*Sin(Ez)+Sin(Ex)*Sin(Ey)*Cos(Ez))+(Zz3-dZ3)*(Sin(Ex)*Sin(Ez)+Cos(Ex)*Sin(Ey)*Cos(Ez)))/(k3+1) Y3=((Xx3-dX3)*Cos(Ey)*Sin(Ez)+(Yy3-dY3)*(Sin(Ex)*Sin(Ey)*Sin(Ez)+Cos(Ex)*Cos(Ez))+(Zz3-dZ3)*(-Sin(Ex)*Cos(Ez)+Cos(Ex)*Sin(Ey)*Sin(Ez)))/(k3+1) Z3=((Xx3-dX3)*(-Sin(Ey))+(Yy3-dY3)*Sin(Ex)*Cos(Ey)+(Zz3-dZ3)*(Cos(Ex)*Cos(Ey)))/(k3+1) =Format(X3,"") =Format(Y3,"") =Format(Z3,"") EndSub PrivateSubcmdExit_Click() End EndSub PrivateSubForm_Load() =4440 EndSub '弧度化为度.分秒的形式: 输入弧度值,输出度.分秒(各占两位) 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+ Ifmiao=60Then fen=fen+1 miao=0 EndIf HuToDo=du+fen/100+miao/10000 EndFunction '将度.分秒形式化为弧度: 输入为度.分秒形式,输出为弧度 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 EndFunction '矩阵转置的通用进程 PublicSubMatrixTrans(A,At) Dimi%,j% DimR1%,C1% OnErrorResumeNext C1=UBound(A,2)-LBound(A,2)+1 IfErrThen MsgBox"输入的矩阵维数不对! " ExitSub EndIf R1=UBound(A,1)-LBound(A,1)+1 ReDimc(1ToC1,1ToR1) Fori=1ToR1 Forj=1ToC1 At(j,i)=A(i,j) Nextj Nexti EndSub '矩阵相乘: 输入矩阵或数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 OnErrorResumeNext'看Qa是不是一维数组 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 OnErrorResumeNext ia=UBound(Qa)-LBound(Qa) IfErrThene6=True Ife6Then'数乘以二维矩阵 Forai=LBound(Qb,1)ToUBound(Qb,1) Forbi=LBound(Qb,2)ToUBound(Qb,2) Qn(ai,bi)=Qa*Qb(ai,bi) Nextbi Nextai Else'一维矩阵乘以二维矩阵 Forci=LBound(Qb,2)ToUBound(Qb,2) Forai=LBound(Qa,1)ToUBound(Qa,1) Qn(ci)=Qn(ci)+Qa(ai)*Qb(ai,ci) Nextai Nextci EndIf ElseIfe1=FalseAnde2=TrueThen OnErrorResumeNext ic=UBound(Qb)-LBound(Qb) IfErrThene7=True Ife7Then'二维矩阵乘以数 Forai=LBound(Qa,1)ToUBound(Qa,1) Forbi=LBound(Qa,2)ToUBound(Qa,2) Qn(ai,bi)=Qa(ai,bi)*Qb Nextbi Nextai Else'二维矩阵乘以一维矩阵 Forai=LBound(Qa,1)ToUBound(Qa,1) Forbi=LBound(Qa,2)ToUBound(Qa,2) Qn(ai)=Qn(ai)+Qa(ai,bi)*Qb(bi) Nextbi Nextai EndIf Else DimerrTAsInteger OnErrorResumeNext'结果是不是是一个数 errT=UBound(Qn) IfErrThene3=True Ife3Then'一维矩阵乘以一维矩阵得一个数 Forai=LBound(Qa,1)ToUBound(Qa,1) Forbi=LBound(Qa,2)ToUBound(Qa,2) Qn=Qn+Qa(ai)*Qb(bi) Nextbi Nextai ExitSub EndIf OnErrorResumeNext'是不是是数乘一维矩阵 ia=UBound(Qa)-LBound(Qa) IfErrThene4=True Ife4Then Forbi=LBound(Qa,2)ToUBound(Qa,2) Qn(bi)=Qa*Qb(bi) Nextbi ExitSub EndIf OnErrorResumeNext'是不是是一维矩阵乘数 ib=UBound(Qb)-LBound(Qb) IfErrThene5=True Ife5Then Forai=LBound(Qa,1)ToUBound(Qa,1) Qn(ai)=Qa(ai)*Qb Nextai ExitSub EndIf '一维矩阵相乘结果是二维矩阵 Forai=LBound(Qa,1)ToUBound(Qa,1) Forbi=LBound(Qa,2)ToUBound(Qa,2) Qn(ai,bi)=Qa(ai)*Qb(bi) Nextbi Nextai EndIf EndSub PublicSubShowMatrix(tt) Dimi%,j%,n%,m% m=UBound(tt,1)-LBound(tt,1)+1 n=UBound(tt,2)-LBound(tt,2)+1 Fori=1Tom Forj=1Ton tt(i,j), Nextj Nexti EndSub '列选主元法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 MsgBox"方程组的系数矩阵有误! " ExitSub EndIf '预备约化进程的变量和数组 n=UBound(b)-LBound(b)+1 Ifn<>RowThen MsgBox"方程组的系数矩阵与常数项大小不符! " ExitSub EndIf 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 EndIf 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 EndIf '约化进程 ForiRow=iStep+1Ton L(iRow)=A(iRow,iStep)/A(iStep,iStep) ForiCol=iStepTon A(iRow,iCol)=A(iRow,iCol)-L(iRow)*A(iStep,iCol) NextiCol b(iRow)=b(iRow)-L(iRow)*b(iStep) NextiRow 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) NextiCol x(iRow)=(b(iRow)-sumAX)/A(iRow,iRow) NextiRow EndSub OptionExplicit DimiMark%'测站计数器 Dimdist! dH! PrivateSubcmdCancel_Click() '清除已经传给主窗体的数据 Dimi% Fori=1ToiMark dis(i)=0 detH(i)=0 Nexti '清除主窗体的显示 ="水准计算结果: " '卸载输入窗体 UnloadMe EndSub PrivateSubcmdOK_Click() dist=Val dH=Val CallAddData(iMark,dist,dH) '在主窗体显示本站数据 =&"第"&Str(iMark)&"站: "&vbC
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- VB 坐标 转换 程序设计
![提示](https://static.bingdoc.com/images/bang_tan.gif)