《导线平差11585》由会员分享，可在线阅读，更多相关《导线平差11585（10页珍藏版）》请在金锄头文库上搜索。
1、导线平差.txt 小时候觉得父亲不简单，后来觉得自己不简单，再后来觉得自己孩子不简单。 越是想知道自己是不是忘记的时候，反而记得越清楚。Sub 单一附合导线平差计算()Dim sel_R As StringUserForm2.Show End SubPrivate Sub CommandButton1_Click()Private Sub CommandButton2_Click()Dim STR1 As StringDim STR2 As StringFor i = 2 To 60 Step 2STR1 = “A“ + CStr(i)STR2 = “A“ + CStr(i + 1)Call
2、CELL_HB(STR1, STR2)STR1 = “B“ + CStr(i)STR2 = “B“ + CStr(i + 1)Call CELL_HB(STR1, STR2)STR1 = “C“ + CStr(i)STR2 = “C“ + CStr(i + 1)Call CELL_HB(STR1, STR2)STR1 = “J“ + CStr(i)STR2 = “J“ + CStr(i + 1)Call CELL_HB(STR1, STR2)STR1 = “K“ + CStr(i)STR2 = “K“ + CStr(i + 1)Call CELL_HB(STR1, STR2)STR1 = “D
3、“ + CStr(i + 1)STR2 = “D“ + CStr(i + 2)Call CELL_HB(STR1, STR2)STR1 = “E“ + CStr(i + 1)STR2 = “E“ + CStr(i + 2)Call CELL_HB(STR1, STR2)STR1 = “F“ + CStr(i + 1)STR2 = “F“ + CStr(i + 2)Call CELL_HB(STR1, STR2)STR1 = “G“ + CStr(i + 1)STR2 = “G“ + CStr(i + 2)Call CELL_HB(STR1, STR2)STR1 = “H“ + CStr(i +
4、 1)STR2 = “H“ + CStr(i + 2)Call CELL_HB(STR1, STR2)STR1 = “I“ + CStr(i + 1)STR2 = “I“ + CStr(i + 2)Call CELL_HB(STR1, STR2)NextEnd SubPublic Sub CELL_FJ(CELL_ALL As String) Macro4 Macro 宏由 hgq 录制，时间: 2009-7-30Range(CELL_ALL).SelectWith Selection.HorizontalAlignment = xlGeneral.VerticalAlignment = xl
5、Center.WrapText = False.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = TrueEnd WithSelection.UnMerge End Sub Private Sub CommandButton1_Click()Dim i As IntegerDim N As IntegerDim x1 As DoubleDim y1 As DoubleDim x2 As DoubleDim y2 As Double
6、Dim x3 As DoubleDim y3 As DoubleDim x4 As DoubleDim y4 As DoubleDim f1 As DoubleDim f2 As DoubleDim f1_g As DoubleDim f2_g As DoubleDim g, ss As DoubleDim f As DoubleDim pi As DoubleDim DF, DDF As DoubleDim DX, DY, X, Y, DDX, DDY As DoubleDim CELL_ALL As StringDim CELL1 As StringDim CELL2 As StringD
7、im STR1, STR2 As StringDim S As DoubleDim DX0, DY0 As Doublepi = 3.141592654i = 2x1 = Cells(i, 10)y1 = Cells(i, 11)x2 = Cells(i + 2, 10)y2 = Cells(i + 2, 11)Call xy_rf(x1, y1, x2, y2)f1 = fxjs0f1_g = dms(f1 * 180 / pi)DX = x2 - x1: DY = y2 - y1S = Sqr(DX * DX + DY * DY)Cells(3, 4) = s 起算边边长Cells(3,
8、5) = f1_g 起算边方位角S = Cells(6, 3)f = f1: i = 2: g = 100: N = 0While i 0i = i + 2g = deg(Cells(i, 2) * pi / 180If g 0 ThenN = N + 1If f = pi Thenf = f - piElsef = f + piEnd Iff = f + gIf f 2 * pi Thenf = f - 2 * piEnd IfEnd IfWendi = i - 2x3 = Cells(i, 10): y3 = Cells(i, 11)x4 = Cells(i + 2, 10): y4 =
9、Cells(i + 2, 11)Call xy_rf(x3, y3, x4, y4)f2 = fxjs0DF = f2 - fIf DF pi ThenDF = DF - 2 * piElseIf DF = pi Thenf = f - piElsef = f + piEnd Iff = f + g + DDFIf f 2 * pi Thenf = f - 2 * piEnd IfCells(j + 1, 5) = dms(f * 180 / pi)DX = S * Cos(f): DY = S * Sin(f)Cells(j + 1, 6) = DX: Cells(j + 1, 7) = D
10、YX = X + DX: Y = Y + DYNextCells(i, 3) = DDF * 206265DX = x3 - X: DY = y3 - Y: DDX = DX / ss: DDY = DY / ssDX0 = DX: DY0 = DYX = x2: Y = y2For j = 6 To i Step 2S = Cells(j - 1, 4)DX = Cells(j - 1, 6) + DDX * S: DY = Cells(j - 1, 7) + DDY * SX = X + DX: Y = Y + DYCells(j - 1, 8) = DDX * S: Cells(j -
11、1, 9) = DDY * SIf j 0 Thenfxjs0 = pi / 2#ElseIf DY 0 Thenfxjs0 = pi / (-2#)ElseMsgBox “两点在同一位置，无法计算方位角.“End IfElsefxjs0 = Atn(DY / DX)If DX 0 Then fxjs0 = fxjs0 + piIf fxjs0 0 Then fxjs0 = fxjs0 + 2 * piEnd If End SubPublic Sub CELL_HB(CELL1 As String, CELL2 As String) Macro4 Macro 宏由 hgq 录制，时间: 200
12、9-7-29 Dim cellall As Stringcellall = CELL1 & “:“ & CELL2Range(cellall).SelectWith Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenter.WrapText = False.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = FalseEnd WithSelection
13、.Merge End SubPrivate Sub CommandButton2_Click()Dim STR1 As StringDim STR2 As StringFor i = 2 To 60 Step 2STR1 = “A“ + CStr(i)STR2 = “A“ + CStr(i + 1)Call CELL_HB(STR1, STR2)STR1 = “B“ + CStr(i)STR2 = “B“ + CStr(i + 1)Call CELL_HB(STR1, STR2)STR1 = “C“ + CStr(i)STR2 = “C“ + CStr(i + 1)Call CELL_HB(S
14、TR1, STR2)STR1 = “J“ + CStr(i)STR2 = “J“ + CStr(i + 1)Call CELL_HB(STR1, STR2)STR1 = “K“ + CStr(i)STR2 = “K“ + CStr(i + 1)Call CELL_HB(STR1, STR2)STR1 = “D“ + CStr(i + 1)STR2 = “D“ + CStr(i + 2)Call CELL_HB(STR1, STR2)STR1 = “E“ + CStr(i + 1)STR2 = “E“ + CStr(i + 2)Call CELL_HB(STR1, STR2)STR1 = “F“
15、 + CStr(i + 1)STR2 = “F“ + CStr(i + 2)Call CELL_HB(STR1, STR2)STR1 = “G“ + CStr(i + 1)STR2 = “G“ + CStr(i + 2)Call CELL_HB(STR1, STR2)STR1 = “H“ + CStr(i + 1)STR2 = “H“ + CStr(i + 2)Call CELL_HB(STR1, STR2)STR1 = “I“ + CStr(i + 1)STR2 = “I“ + CStr(i + 2)Call CELL_HB(STR1, STR2)NextEnd SubPublic Sub
16、CELL_FJ(CELL_ALL As String) Macro4 Macro 宏由 hgq 录制，时间: 2009-7-30Range(CELL_ALL).SelectWith Selection.HorizontalAlignment = xlGeneral.VerticalAlignment = xlCenter.WrapText = False.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = TrueEnd WithSelection.UnMerge End Sub
