导线平差.docx
- 文档编号:10710600
- 上传时间:2023-05-27
- 格式:DOCX
- 页数:15
- 大小:16.39KB
导线平差.docx
《导线平差.docx》由会员分享,可在线阅读,更多相关《导线平差.docx(15页珍藏版)》请在冰点文库上搜索。
导线平差
导线平差.txt小时候觉得父亲不简单,后来觉得自己不简单,再后来觉得自己孩子不简单。
越是想知道自己是不是忘记的时候,反而记得越清楚。
Sub单一附合导线平差计算()
'Dimsel_RAsString
UserForm2.Show
EndSub
'PrivateSubCommandButton1_Click()
PrivateSubCommandButton2_Click()
DimSTR1AsString
DimSTR2AsString
Fori=2To60Step2
STR1="A"+CStr(i)
STR2="A"+CStr(i+1)
CallCELL_HB(STR1,STR2)
STR1="B"+CStr(i)
STR2="B"+CStr(i+1)
CallCELL_HB(STR1,STR2)
STR1="C"+CStr(i)
STR2="C"+CStr(i+1)
CallCELL_HB(STR1,STR2)
STR1="J"+CStr(i)
STR2="J"+CStr(i+1)
CallCELL_HB(STR1,STR2)
STR1="K"+CStr(i)
STR2="K"+CStr(i+1)
CallCELL_HB(STR1,STR2)
STR1="D"+CStr(i+1)
STR2="D"+CStr(i+2)
CallCELL_HB(STR1,STR2)
STR1="E"+CStr(i+1)
STR2="E"+CStr(i+2)
CallCELL_HB(STR1,STR2)
STR1="F"+CStr(i+1)
STR2="F"+CStr(i+2)
CallCELL_HB(STR1,STR2)
STR1="G"+CStr(i+1)
STR2="G"+CStr(i+2)
CallCELL_HB(STR1,STR2)
STR1="H"+CStr(i+1)
STR2="H"+CStr(i+2)
CallCELL_HB(STR1,STR2)
STR1="I"+CStr(i+1)
STR2="I"+CStr(i+2)
CallCELL_HB(STR1,STR2)
Next
EndSub
PublicSubCELL_FJ(CELL_ALLAsString)
'
'Macro4Macro
'宏由hgq录制,时间:
2009-7-30
'
'
Range(CELL_ALL).Select
WithSelection
.HorizontalAlignment=xlGeneral
.VerticalAlignment=xlCenter
.WrapText=False
.Orientation=0
.AddIndent=False
.IndentLevel=0
.ShrinkToFit=False
.ReadingOrder=xlContext
.MergeCells=True
EndWith
Selection.UnMerge
EndSub
PrivateSubCommandButton1_Click()
DimiAsInteger
DimNAsInteger
Dimx1AsDouble
Dimy1AsDouble
Dimx2AsDouble
Dimy2AsDouble
Dimx3AsDouble
Dimy3AsDouble
Dimx4AsDouble
Dimy4AsDouble
Dimf1AsDouble
Dimf2AsDouble
Dimf1_gAsDouble
Dimf2_gAsDouble
Dimg,ssAsDouble
DimfAsDouble
DimpiAsDouble
DimDF,DDFAsDouble
DimDX,DY,X,Y,DDX,DDYAsDouble
DimCELL_ALLAsString
DimCELL1AsString
DimCELL2AsString
DimSTR1,STR2AsString
DimSAsDouble
DimDX0,DY0AsDouble
pi=3.141592654
i=2
x1=Cells(i,10)
y1=Cells(i,11)
x2=Cells(i+2,10)
y2=Cells(i+2,11)
Callxy_rf(x1,y1,x2,y2)
f1=fxjs0
f1_g=dms(f1*180/pi)
DX=x2-x1:
DY=y2-y1
S=Sqr(DX*DX+DY*DY)
'Cells(3,4)=s'起算边边长
Cells(3,5)=f1_g'起算边方位角
S=Cells(6,3)
f=f1:
i=2:
g=100:
N=0
Whilei<66Andg>0
i=i+2
g=deg(Cells(i,2))*pi/180
Ifg>0Then
N=N+1
Iff>=piThen
f=f-pi
Else
f=f+pi
EndIf
f=f+g
Iff>2*piThen
f=f-2*pi
EndIf
EndIf
Wend
i=i-2
x3=Cells(i,10):
y3=Cells(i,11)
x4=Cells(i+2,10):
y4=Cells(i+2,11)
Callxy_rf(x3,y3,x4,y4)
f2=fxjs0
DF=f2-f
IfDF>piThen
DF=DF-2*pi
Else
IfDF<-1*piThen
DF=DF+pi
EndIf
EndIf
DDF=DF/N
f=f1:
X=x2:
Y=y2:
ss=0
Forj=4ToiStep2
S=Cells(j+1,4)
ss=ss+S'导线总长
g=deg(Cells(j,2))*pi/180
Cells(j,3)=DDF*206265
N=N+1
Iff>=piThen
f=f-pi
Else
f=f+pi
EndIf
f=f+g+DDF
Iff>2*piThen
f=f-2*pi
EndIf
Cells(j+1,5)=dms(f*180/pi)
DX=S*Cos(f):
DY=S*Sin(f)
Cells(j+1,6)=DX:
Cells(j+1,7)=DY
X=X+DX:
Y=Y+DY
Next
Cells(i,3)=DDF*206265
DX=x3-X:
DY=y3-Y:
DDX=DX/ss:
DDY=DY/ss
DX0=DX:
DY0=DY
X=x2:
Y=y2
Forj=6ToiStep2
S=Cells(j-1,4)
DX=Cells(j-1,6)+DDX*S:
DY=Cells(j-1,7)+DDY*S
X=X+DX:
Y=Y+DY
Cells(j-1,8)=DDX*S:
Cells(j-1,9)=DDY*S
Ifj Cells(j,10)=X: Cells(j,11)=Y EndIf Next i=i+4 CELL_ALL="A"+CStr(i)+": "+"A"+CStr(i+1) CallCELL_FJ(CELL_ALL) CELL_ALL="B"+CStr(i)+": "+"B"+CStr(i+1) CallCELL_FJ(CELL_ALL) CELL_ALL="C"+CStr(i)+": "+"C"+CStr(i+1) CallCELL_FJ(CELL_ALL) CELL_ALL="D"+CStr(i-1)+": "+"D"+CStr(i) CallCELL_FJ(CELL_ALL) CELL_ALL="D"+CStr(i+1)+": "+"D"+CStr(i+2) CallCELL_FJ(CELL_ALL) CELL_ALL="E"+CStr(i-1)+": "+"E"+CStr(i) CallCELL_FJ(CELL_ALL) CELL_ALL="E"+CStr(i+1)+": "+"E"+CStr(i+2) CallCELL_FJ(CELL_ALL) CELL_ALL="F"+CStr(i-1)+": "+"F"+CStr(i) CallCELL_FJ(CELL_ALL) CELL_ALL="F"+CStr(i+1)+": "+"F"+CStr(i+2) CallCELL_FJ(CELL_ALL) CELL_ALL="G"+CStr(i-1)+": "+"G"+CStr(i) CallCELL_FJ(CELL_ALL) CELL_ALL="G"+CStr(i+1)+": "+"G"+CStr(i+2) CallCELL_FJ(CELL_ALL) CELL_ALL="H"+CStr(i-1)+": "+"H"+CStr(i) CallCELL_FJ(CELL_ALL) CELL_ALL="H"+CStr(i+1)+": "+"H"+CStr(i+2) CallCELL_FJ(CELL_ALL) CELL_ALL="I"+CStr(i-1)+": "+"I"+CStr(i) CallCELL_FJ(CELL_ALL) CELL_ALL="I"+CStr(i+1)+": "+"I"+CStr(i+2) CallCELL_FJ(CELL_ALL) CELL_ALL="J"+CStr(i)+": "+"J"+CStr(i+1) CallCELL_FJ(CELL_ALL) CELL_ALL="K"+CStr(i)+": "+"K"+CStr(i+1) CallCELL_FJ(CELL_ALL) CELL1="B"+CStr(i): CELL2="K"+CStr(i) CallCELL_HB(CELL1,CELL2) CELL1="B"+CStr(i+1): CELL2="K"+CStr(i+1) CallCELL_HB(CELL1,CELL2) STR1="角度闭合差="+Format(DF*206265,"000.0")+"秒" Cells(i,2)=STR1 S=Sqr(DX0*DX0+DY0*DY0) STR2="DX="+Format(DX0*1000,"000.0")+"mmDY="+Format(DY0*1000,"000.0")+"mmDS="+Format(S*1000,"000.0")+"mm导线总长="+Format(ss,"0000.0")+"m导线相对闭合差="+"1: "+CStr(Fix(ss/S)) Cells(i+1,2)=STR2 EndSub PublicSubxy_rf(x1AsDouble,y1AsDouble,x2AsDouble,y2AsDouble) DimDX,DYAsDouble DimpiAsDouble pi=3.141592654 DX=x2-x1: DY=y2-y1 IfDX=0Then IfDY>0Then fxjs0=pi/2# ElseIfDY<0Then fxjs0=pi/(-2#) Else MsgBox"两点在同一位置,无法计算方位角." EndIf Else fxjs0=Atn(DY/DX) IfDX<0Thenfxjs0=fxjs0+pi Iffxjs0<0Thenfxjs0=fxjs0+2*pi EndIf EndSub PublicSubCELL_HB(CELL1AsString,CELL2AsString) ' 'Macro4Macro '宏由hgq录制,时间: 2009-7-29 ' ' DimcellallAsString cellall=CELL1&": "&CELL2 Range(cellall).Select WithSelection .HorizontalAlignment=xlCenter .VerticalAlignment=xlCenter .WrapText=False .Orientation=0 .AddIndent=False .IndentLevel=0 .ShrinkToFit=False .ReadingOrder=xlContext .MergeCells=False EndWith Selection.Merge EndSub PrivateSubCommandButton2_Click() DimSTR1AsString DimSTR2AsString Fori=2To60Step2 STR1="A"+CStr(i) STR2="A"+CStr(i+1) CallCELL_HB(STR1,STR2) STR1="B"+CStr(i) STR2="B"+CStr(i+1) CallCELL_HB(STR1,STR2) STR1="C"+CStr(i) STR2="C"+CStr(i+1) CallCELL_HB(STR1,STR2) STR1="J"+CStr(i) STR2="J"+CStr(i+1) CallCELL_HB(STR1,STR2) STR1="K"+CStr(i) STR2="K"+CStr(i+1) CallCELL_HB(STR1,STR2) STR1="D"+CStr(i+1) STR2="D"+CStr(i+2) CallCELL_HB(STR1,STR2) STR1="E"+CStr(i+1) STR2="E"+CStr(i+2) CallCELL_HB(STR1,STR2) STR1="F"+CStr(i+1) STR2="F"+CStr(i+2) CallCELL_HB(STR1,STR2) STR1="G"+CStr(i+1) STR2="G"+CStr(i+2) CallCELL_HB(STR1,STR2) STR1="H"+CStr(i+1) STR2="H"+CStr(i+2) CallCELL_HB(STR1,STR2) STR1="I"+CStr(i+1) STR2="I"+CStr(i+2) CallCELL_HB(STR1,STR2) Next EndSub PublicSubCELL_FJ(CELL_ALLAsString) ' 'Macro4Macro '宏由hgq录制,时间: 2009-7-30 ' ' Range(CELL_ALL).Select WithSelection .HorizontalAlignment=xlGeneral .VerticalAlignment=xlCenter .WrapText=False .Orientation=0 .AddIndent=False .IndentLevel=0 .ShrinkToFit=False .ReadingOrder=xlContext .MergeCells=True EndWith Selection.UnMerge EndSub
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 导线