谁有VB闭合导线坐标计算的源代码

Const pi As Single = 3.14159265358979

Dim jd(1 To 500) As Double

Dim ds(1 To 500) As Double

Dim n As Integer

Dim jdh As Double

Dim gzj(1 To 500) As String

Dim fwj As Double

Dim zbfwj(0 To 500) As Double

Dim zbfwj1(0 To 500) As String

Dim dx(1 To 500) As Single, dy(1 To 500) As Single

Dim x(1 To 500) As Single, y(1 To 500) As Single

Public Function Deg2Rad(a As Double) As Double

Dim Ra As Double

Dim c As Double

Dim d As Double

Dim e As Long

Dim f As Long

Ra = pi / 180

e = Int(a)

c = (a - e) * 100

f = Int(c)

d = (c - f) * 100

Deg2Rad = (e + f / 60 + d / 3600) * Ra

End Function

Public Function Degree(a As Double) As Double

Dim b As Double

Dim Fs1 As Double

Dim Im1 As Integer

Dim Id1 As Integer

b = a

Call DMS(b, Id1, Im1, Fs1)

Degree = Id1 + Im1 / 100# + Fs1 / 10000#

End Function

Public Sub DMS(a As Double, ID As Integer, IM As Integer, FS As Double)

Dim b As Double

Dim c As Double

c = a

c = 180# / pi * c

ID = Int(c + 0.0000005)

b = (c - ID) * 60 + 0.0005

IM = Int(b)

FS = (b - IM) * 60

End Sub

Public Function Deg2DMS(b As Double) As String

Dim a As Double

Dim ad As Single

Dim d As Single

Dim ag As Single

Dim e As Single

Dim ah As Single

a = b + 0.00005

ad = Format(Fix(a))

d = a - ad

ag = Format(Fix(d * 100))

e = d * 100 - ag

ah = Int(e * 100)

Deg2DMS = ad &"°" &ag &"′" &ah &"〃"颤培旦

End Function

Private Sub Command1_Click()

CommonDialog1.Filter = "所茄扰有文件 (*.*)|*.*"

CommonDialog1.FilterIndex = 1

CommonDialog1.InitDir = App.Path &IIf(Right(App.Path, 1) = "\", "中洞", "\") &"数据"

CommonDialog1.Action = 1

Open CommonDialog1.FileName For Input As #1

i = 0: j = 0

Do While Not EOF(1)

i = i + 1

Input #1, jd(i)

gzj(i) = Deg2DMS(jd(i))

Text4.Text = Text4.Text &gzj(i) &vbCrLf

Loop

Close #1

n = i

End Sub

Private Sub Command4_Click()

Dim yz As String

CommonDialog1.Filter = "所有文件 (*.*)|*.*"

CommonDialog1.FilterIndex = 1

CommonDialog1.InitDir = App.Path &IIf(Right(App.Path, 1) = "\", "", "\") &"数据"

CommonDialog1.Action = 1

Open CommonDialog1.FileName For Input As #1

Input #1, fwj

yz = Deg2DMS(fwj)

Text1.Text = Text1.Text &yz &vbCrLf

End Sub

Private Sub Command3_Click()

CommonDialog1.Filter = "所有文件 (*.*)|*.*"

CommonDialog1.FilterIndex = 1

CommonDialog1.InitDir = App.Path &IIf(Right(App.Path, 1) = "\", "", "\") &"数据"

CommonDialog1.Action = 1

Open CommonDialog1.FileName For Input As #1

i = 0: j = 0

Do While Not EOF(1)

i = i + 1

Input #1, ds(i)

Text7.Text = Text7.Text &ds(i) &vbCrLf

Loop

Close #1

n = i

End Sub

Private Sub Command2_Click()

Dim af As Double, ad As String, ag As Integer, gzs As Double, dsh As Single, wd As Double

Dim dyh As Single, dxh As Single

Dim y1 As Single, x1 As Single

Dim jd1(1 To 500) As Double

For i = 1 To n

jd(i) = Deg2Rad(jd(i))

Next

For i = 1 To n

jdh = jdh + jd(i)

Next

af = Degree(jdh - pi * (n - 2))

ad = Deg2DMS(af)

Text9.Text = ad

gzs = (jdh - pi * (n - 2)) / n

For i = 1 To n

jd(i) = jd(i) - gzs

jd1(i) = Degree(jd(i))

gzj(i) = Deg2DMS(jd1(i))

Text5.Text = Text5.Text &gzj(i) &vbCrLf

Next

fwj = Deg2Rad(fwj)

zbfwj(0) = fwj

For i = 1 To n

zbfwj(i) = zbfwj(i - 1) + jd(i)

If zbfwj(i) >= 2 * pi Then

zbfwj(i) = zbfwj(i) - 2 * pi

End If

If zbfwj(i) >= pi Then

zbfwj(i) = zbfwj(i) - pi

ElseIf zbfwj(i) <pi Then

zbfwj(i) = zbfwj(i) + pi

End If

Next

For i = 1 To n

zbfwj(i) = Degree(zbfwj(i))

zbfwj1(i) = Deg2DMS(zbfwj(i))

Text6.Text = Text6.Text &zbfwj1(i) &vbCrLf

Next

For i = 1 To n

zbfwj(i) = Deg2Rad(zbfwj(i))

Next

dx(1) = Cos(zbfwj(0)) * ds(1)

dy(1) = Sin(zbfwj(0)) * ds(1)

For i = 2 To n

dx(i) = Cos(zbfwj(i - 1)) * ds(i)

dy(i) = Sin(zbfwj(i - 1)) * ds(i)

Next

For i = 1 To n

dxh = dxh + dx(i)

dyh = dyh + dy(i)

Next

For i = 1 To n

dsh = dsh + ds(i)

Next

For i = 1 To n

dx(i) = dx(i) - dxh * ds(i) / dsh

dy(i) = dy(i) - dyh * ds(i) / dsh

Next

x1 = Val(Text2.Text)

y1 = Val(Text3.Text)

x(1) = x1 + dx(1)

y(1) = y1 + dy(1)

For i = 2 To n

x(i) = x(i - 1) + dx(i)

y(i) = y(i - 1) + dy(i)

Next

For i = 1 To n

Text8.Text = Text8.Text &x(i) &vbCrLf

Text10.Text = Text10.Text &y(i) &vbCrLf

Next

wd = (Sqr((dxh) * (dxh) + (dyh) * (dyh))) / dsh

wd = Int(1 / wd)

Text11.Text = "fx=" &Int(dxh * 10000 + 0.5) / 10000 &" " &"fy=" &Int(dyh * 10000 + 0.5) / 10000 &" " &"WD=1/" &wd

End Sub

Private Sub Command5_Click()

Unload Form2

Dim nForm As New Form2

Form2.Show

End Sub

Private Sub Command6_Click()

Form3.Show

Form2.Hide

End Sub

对于直接对观测点的观测坐标值进行近似平差的方法：例如是附和导线，已知点A，B，C,D,用A点茄碧蔽定向，全站仪测出导线点坐标附和到C，设全站仪测出C点坐标为Xc1，Yc1，已知C点坐标为Xc，Yc，用C点的观测坐标值与已知坐标值比较，得到fx=Xc1-Xc，fy=Yc1-Yc；可以计算出导线闭合差fd，就是fx的平方与fy的平差和再开平方。同时就可以计算出导线全长相对闭合差，当导线全站相对闭合差不大于规范规定时，就可以进行坐标改正数的计算：Vxi=（-fx/D)（D1+D2+D3+....Di-1),Vyi=(-fy/D)*(D1+D2+D3+....Di-1),其中D是导线全长，（不包括高级边，包含连接边），Di-1是第i点之前的导线边长。改正后坐标为：Xi=Xi1+Vxi，颤州Yi=Yi1+Vyi

对于高程可以用同样的方法来计算高程慧伏改正数。

导线测量的内业计算步骤：

第一步：准备工作：将校核过的外业观测数据及起算数据填入闭合导线坐标计算表中。

第二步：角度闭合差的计算与调整。

第三步：用改正后的转折角推算各边的坐标方位角。

第四步：坐标增量闭合差的计算与调整。

扩展资料：

在测区范围内的地面上按一定要求选定的具有控制意义的点子称为控制点。将测区内相邻控制点连成直线所构成的折线称为导线，其中的控制点也称为导线点，折线边也称为导线边。

导线测量就是依次测定各导线边的长度和各转折角值，再根据燃肆皮起始数据，推算各边的坐标方位角，求出各导线点的坐标，从而确定各点平面位置的测量方法。导线测量在建立小地区平面控制网中经常采用，尤其在地物分布较复杂的建筑区、视线障碍较多的隐蔽区及带状地区常采用这种方皮差法。

使用经纬仪测量雹虚转折角，用钢尺测定边长的导线，称为经纬仪导线；若使用光电测距仪或全站仪测定导线边长，则称为电磁波测距导线。

导线测量平面控制网根据测区范围和精度要求分为一级、二级、三级和图根4个等级。

---