【VB.net】大地测量——白塞尔大地解算程序设计

最新推荐文章于 2024-10-31 17:56:04 发布
原创 最新推荐文章于 2024-10-31 17:56:04 发布 · 2.1k 阅读 · 34 ·
本内容遵循CC 4.0 BY-SA版权协议
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
收录于
VB.net

当前文章被收录于：

VB.net
3 篇文章 5 人学习
订阅专栏 查看详情

1.窗口

在这里插入图片描述

2.Form

Public Class Form1
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    End Sub
    '这里是正算
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim i, j, k, a, b, x, h, f, g As Double
        If ComBox1.Text = "克拉索夫斯基椭球" Then
            eff = 0.006738525414683
            c = 6399698.901782711
            e2 = 0.006693421622966
        ElseIf ComBox1.Text = "1975年国际椭球" Then
            eff = 0.006739501819473
            c = 6399596.6519880109
            e2 = 0.006694384999588
        ElseIf ComBox1.Text = "WGS-84椭球" Then
            eff = 0.00673949674227
            c = 6399593.6258
            e2 = 0.00669437999013
        ElseIf ComBox1.Text = "CGCS2000" Then
            eff = 0.00673949677548
            c = 6399593.6259
            e2 = 0.0066943800229
        End If
        '输入变量
        B1 = Math.Abs(Val(B11.Text)) + Val(B12.Text) / 60 + Val(B13.Text) / 3600
        If Val(B11.Text) > 0 Then
            B1 = B1
        Else B1 = -B1
        End If
        L1 = Math.Abs(Val(L11.Text)) + Val(L12.Text) / 60 + Val(L13.Text) / 3600
        If Val(L11.Text) > 0 Then
            L1 = L1
        Else : L1 = -L1
        End If
        A1 = Math.Abs(Val(A7.Text)) + Val(A8.Text) / 60 + Val(A9.Text) / 3600
        If (Val(A7.Text) > 0) Then
            A1 = A1
        Else A1 = -A1
        End If                         '将度分秒转化成十进制的度数
        S = Val(SS.Text)
        '计算起点的归化纬度
        Dim W1, SinU1, CosU1 As Double
        W1 = Math.Sqrt(1 - e2 * (Math.Sin(B1 / 180 * Math.PI)) ^ 2)
        SinU1 = Math.Sin(B1 / 180 * Math.PI) * Math.Sqrt(1 - e2) / W1
        CosU1 = Math.Cos(B1 / 180 * Math.PI) / W1
        '计算辅助函数值
        Dim SinA0, Cotσ1, Sin2σ1, Cos2σ1 As Double
        SinA0 = CosU1 * Math.Sin(A12 / 180 * Math.PI)
        Cotσ1 = CosU1 * Math.Cos(A12 / 180 * Math.PI) / SinU1
        Sin2σ1 = 2 * Cotσ1 / ((Cotσ1) ^ 2 + 1)
        Cos2σ1 = ((Cotσ1) ^ 2 - 1) / ((Cotσ1) ^ 2 + 1)
        '计算系数A,B,C及α,β之值Dim A, B, C, α, β As Double
        a = 6356863.02 + (10708.949 - 13.474 * (1 - (SinA0) ^ 2)) * (1 - (SinA0) ^ 2)
        b = (5354.469 - 8.978 * (1 - (SinA0) ^ 2)) * (1 - (SinA0) ^ 2)
        c = (2.238 * (1 - (SinA0) ^ 2)) * (1 - (SinA0) ^ 2) + 0.006
        α = 691.46768 - (0.58143 - 0.00144 * (1 - (SinA0) ^ 2)) * (1 - (SinA0) ^ 2)
        β = (0.2907 - 0.001 * (1 - (SinA0) ^ 2)) * (1 - (SinA0) ^ 2)
        '计算球面长度
        Dim σ0, Sin2σ1σ0, Cos2σ1σ0, σ As Double
        σ0 = (S - (b + c * Cos2σ1) * Sin2σ1) * (1 / a)
        Sin2σ1σ0 = Sin2σ1 * Math.Cos(2 * σ0) + Cos2σ1 * Math.Sin(2 * σ0)
        Cos2σ1σ0 = Cos2σ1 * Math.Cos(2 * σ0) - Sin2σ1 * Math.Sin(2 * σ0)
        σ = σ0 + (b + 5 * c * Cos2σ1σ0) * Sin2σ1σ0 / a
        '计算经度差改正数Dim δ As Double
        δ = (α * σ + β * (Sin2σ1σ0 - Sin2σ1)) * SinA0
        '计算终点大地坐标及方位角
        Dim SinU2, B2, λ0, λ, L2, A2 As Double
        SinU2 = SinU1 * Math.Cos(σ) + CosU1 * Math.Cos(A12 / 180 * Math.PI) * Math.Sin(σ)
        B2 = Math.Atan(SinU2 / (Math.Sqrt(1 - e2) * Math.Sqrt(1 - (SinU2) ^ 2))) / Math.PI * 180
        λ0 = Math.Atan((Math.Sin(A12 / 180 * Math.PI) * Math.Sin(σ)) / ((CosU1 * Math.Cos(σ)) - (SinU1 *
    Math.Sin(σ) * Math.Cos(A12 / 180 * Math.PI)))) / Math.PI * 180
        If (Math.Sin(A12 / 180 * Math.PI) > 0) And (Math.Tan(λ0 / 180 * Math.PI) > 0) Then
            λ = Math.Abs(λ0)
        ElseIf (Math.Sin(A12 / 180 * Math.PI) > 0) And (Math.Tan(λ0 / 180 * Math.PI) < 0) Then
            λ = 180 - Math.Abs(λ0)
        ElseIf (Math.Sin(A12 / 180 * Math.PI) < 0) And (Math.Tan(λ0 / 180 * Math.PI) < 0) Then
            λ = -Math.Abs(λ0)
        ElseIf (Math.Sin(A12 / 180 * Math.PI) < 0) And (Math.Tan(λ0 / 180 * Math.PI) > 0) Then
            λ = Math.Abs(λ0) - 180
        End If
        L2 = L1 + λ - δ / 3600
        A2 = Math.Atan((CosU1 * Math.Sin(A12 / 180 * Math.PI)) / ((CosU1 * Math.Cos(σ) * Math.Cos(A12 / 180 * Math.PI)) - (SinU1 * Math.Sin(σ)))) / Math.PI * 180
        If (Math.Sin(A12 / 180 * Math.PI) < 0) And (Math.Tan(A2 / 180 * Math.PI) > 0) Then
            A2 = Math.Abs(A2)
        ElseIf (Math.Sin(A12 / 180 * Math.PI) < 0) And (Math.Tan(A2 / 180 * Math.PI) < 0) Then
            A2 = 180 - Math.Abs(A2)
        ElseIf (Math.Sin(A12 / 180 * Math.PI) > 0) And (Math.Tan(A2 / 180 * Math.PI) > 0) Then
            A2 = 180 + Math.Abs(A2)
        ElseIf (Math.Sin(A12 / 180 * Math.PI) > 0) And (Math.Tan(A2 / 180 * Math.PI) < 0) Then
            A2 = 360 - Math.Abs(A2)
        End If
        '将B2,L2,A2转化成标准角度，输出时把十进制转化成60进制
        i = Math.Truncate(B2)
        j = Math.Truncate((B2 - i) * 60)
        k = Math.Truncate((((B2 - i) * 60) - j) * 60)
        a = Math.Truncate(L2)
        b = Math.Truncate((L2 - a) * 60)
        x = Math.Truncate((((L2 - a) * 60) - b) * 60)
        h = Math.Truncate(A2)
        f = Math.Truncate((A2 - h) * 60)
        g = Math.Truncate((((A2 - h) * 60) - f) * 60)
        B21.Text = CStr(i)
        B22.Text = CStr(j)
        B23.Text = CStr(k)
        L21.Text = CStr(a)
        L22.Text = CStr(b)
        L23.Text = CStr(x)
        A4.Text = CStr(h)
        A5.Text = CStr(f)
        A6.Text = CStr(g)
    End Sub
    '这里是反算
    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        Dim eff, e2, B1, B2, L1, L2 As Double
        Dim i, j, k, a, b, x, h, f, g As Double
        If ComBox1.Text = "克拉索夫斯基椭球" Then
            eff = 0.006738525414683
            e2 = 0.006693421622966
        ElseIf ComBox1.Text = "1975年国际椭球" Then
            eff = 0.006739501819473
            e2 = 0.006694384999588
        ElseIf ComBox1.Text = "WGS-84椭球" Then
            eff = 0.00673949674227
            e2 = 0.00669437999013
        ElseIf ComBox1.Text = "CGCS2000" Then
            eff = 0.00673949677548
            e2 = 0.0066943800229
        End If
        '输入
        B1 = Math.Abs(Val(B11.Text)) + Val(B12.Text) / 60 + Val(B13.Text) / 3600
        If (Val(B11.Text) > 0) Then
            B1 = B1
        Else : B1 = -B1
        End If
        Ll = Math.Abs(Val(L11.Text)) + Val(L12.Text) / 60 + Val(L13.Text) / 3600
        If (Val(L11.Text) > 0) Then
            Ll = Ll
        Else : L1 = -Ll
        End If
        B2 = Math.Abs(Val(B21.Text)) + Val(B22.Text) / 60 + Val(B23.Text) / 3600
        If (Val(B21.Text) > 0) Then
            B2 = B2
        Else : B2 = -B2
        End If
        L2 = Math.Abs(Val(L21.Text)) + Val(L22.Text) / 60 + Val(L23.Text) / 3600
        If (Val(L21.Text) > 0) Then
            L2 = L2
        Else : L2 = -L2
        End If
        '2 计算辅助函数值
        Dim W1, W2, SinU1, SinU2, CosU1, CosU2 As Double
        W1 = Math.Sqrt(1 - e2 * (Math.Sin(B1 / 180 * Math.PI)) ^ 2)
        W2 = Math.Sqrt(1 - e2 * (Math.Sin(B2 / 180 * Math.PI)) ^ 2)
        SinU1 = Math.Sin(B1 / 180 * Math.PI) * Math.Sqrt(1 - e2) / W1
        SinU2 = Math.Sin(B2 / 180 * Math.PI) * Math.Sqrt(1 - e2) / W2
        CosU1 = Math.Cos(B1 / 180 * Math.PI) / W1
        CosU2 = Math.Cos(B2 / 180 * Math.PI) / W2
        Dim L, AX1, AX2, BX1, BX2 As Double
        L = L2 - L1
        AX1 = SinU1 * SinU2
        AX2 = CosU1 * CosU2
        BX1 = CosU1 * SinU2
        BX2 = SinU1 * CosU2
        '③运用逐次趋近法同时计算起算点大地方位角，球面长度及经差λ=L+δ
        Dim pp, q, A1, λ, δ0, δ As Double
        Dim Sinσ, Cosσ, σ As Double
        Dim SinA0, xx, α, β As Double
        δ0 = 1
        Do While Math.Abs(δ - δ0) > 0.000001
            δ0 = δ
            λ = L + δ0
            pp = CosU2 * Math.Sin(λ / 180 * Math.PI)
            q = BX1 - BX2 * Math.Cos(λ / 180 * xx)
            A1 = Math.Atan(pp / q) / Math.PI * 180
            If (pp > 0) And (q > 0) Then
                A1 = Math.Abs(A1)
            ElseIf (pp > 0) And (q < 0) Then
                A1 = 180 - Math.Abs(A1)
            ElseIf (pp < 0) And (q < 0) Then
                A1 = 180 + Math.Abs(A1)
            ElseIf (pp < 0) And (q > 0) Then
                A1 = 360 - Math.Abs(A1)
            End If
            Sinσ = pp * Math.Sin(A1 / 180 * Math.PI) + q * Math.Cos(A1 / 180 * Math.PI)
            Cosσ = AX1 + AX2 * Math.Cos(λ / 180 * Math.PI)
            σ = Math.Atan(Sinσ / Cosσ) / Math.PI * 180
            If (Cosσ > 0) Then
                σ = Math.Abs(σ)
            ElseIf (Cosσ < 0) Then
                σ = 180 - Math.Abs(σ)
            End If
            SinA0 = CosU1 * Math.Sin(A1 / 180 * Math.PI)
            xx = 2 * AX1 - (1 - SinA0 ^ 2) * Cosσ
            α = (33523299 - (28189 - 70 * (1 - SinA0 ^ 2)) * (1 - SinA0 ^ 2)) * 10 ^ (-10)
            β = (28189 - 94 * (1 - SinA0 ^ 2)) * 10 ^ (-10)
            δ = (α * σ - β * xx * Sinσ) * SinA0
        Loop
        δ = δ * 3600
        '④计算系数A,B,C及大地线长度S
        Dim AA, BB, C As Double
        AA = 6356863.02 + (10708.949 - 13.474 * (1 - (SinA0) ^ 2)) * (1 - (SinA0) ^ 2)
        BB = 10708.938 - 17.956 * (1 - (SinA0) ^ 2)
        C = 4.487
        Dim y, S As Double
        y = (((1 - (SinA0) ^ 2)) ^ 2 - 2 * xx ^ 2) * Cosσ
        S = AA * (σ / 180 * Math.PI) + (BB * xx + C * y) * Sinσ
        Dim A2 As Double
        A2 = Math.Atan((CosU1 * Math.Sin(λ / 180 * Math.PI)) / (BX1 * Math.Cos(λ / 180 * Math.PI) - BX2)) / Math.PI * 180
        If (Math.Sin(A1 / 180 * Math.PI) < 0) And (Math.Tan(A2 / 180 * Math.PI) > 0) Then
            A2 = Math.Abs(A2)
        ElseIf (Math.Sin(A1 / 180 * Math.PI) < 0) And (Math.Tan(A21 / 180 * Math.PI) < 0) Then
            A2 = 180 - Math.Abs(A2)
        ElseIf (Math.Sin(A1 / 180 * Math.PI) > 0) And (Math.Tan(A21 / 180 * Math.PI) > 0) Then
            A2 = 180 + Math.Abs(A2)
        ElseIf (Math.Sin(A1 / 180 * Math.PI) > 0) And (Math.Tan(A2 / 180 * Math.PI) < 0) Then
            A2 = 360 - Math.Abs(A2)
        End If
        '⑥将A1, A2转化成标准角度
        i = Math.Truncate(A1)
        j = Math.Truncate((A1 - i) * 60)
        k = Math.Truncate((((A1 - i) * 60) - j) * 60)
        h = Math.Truncate(A2)
        f = Math.Truncate((A2 - h) * 60)
        g = Math.Truncate((((A2 - h) * 60) - f) * 60)
        A7.Text = CStr(i)
        A8.Text = CStr(j)
        A9.Text = CStr(k)
        SS.Text = CStr(S)
        A_1.Text = CStr(h)
        A_2.Text = CStr(f)
        A3.Text = CStr(g)
    End Sub
End Class

3.Module

主要都是全局变量的声明。

Module Module1
    Public eff, c, e2, L1, B1, A12, S, L2, B2, A21 As Double
    Public DB0, DL0, DA0， BD1, DL1, DA1 As Double
    Public Bm, Am, Lm As Double
    Public M1, N1 As Double
    Public Nm, Mm, Vm As Double
    Public p = 206264.80624709636
    Public tm, itam As Double
    Public db, dl, da As Double
End Module
标签
#vb.net #程序设计 #经验分享
C# 大地测量高斯投影正反算公式计算程序
热门推荐
Lynn_whu的博客
09-16 1万+
C# 大地测量高斯投影正反算公式程序 C# 大地测量高斯投影正反算公式计算程序 一、编程作业要求： 编写能够进行高斯投影正反算公式计算的程序。 二、实验效果： 三、部分代码实现 1.选择界面 using System; using System.Collections.Generic; using System.ComponentModel; using S...
【测绘程序设计】——大地主题解算
C_xxy's blog
12-11 4052
测绘程序设计——大地主题解算（包括“高斯平均引数法”与“白塞尔大地主题解算法”）
大地大作业：白塞尔大地主题解算_大地主题解算_白塞尔大地主题解算_
09-29
运用c语言编写的白塞尔主题解算程序，精度要求i符合标准
【PyQT】大地线长度计算工具实现
穿着帆布鞋也能走猫步
03-15 644
本设计实现了一个大地线长度计算工具，用户可以输入两个点的经纬度坐标，然后点击计算按钮，程序会根据输入的经纬度坐标计算出这两个点之间的大地线长度，并将结果显示在界面上。
白塞尔_白塞尔大地主题解算正反解_
09-29
能够实现白塞尔大地主题解算正反解，c++语言，完整可直接运行
大地测量学高斯投影正反算代码及EXE应用程序
12-30
编写的大地测量学里面的小程序，用C#编写的界面程序
大地问题正反算
09-21
大地问题正反算，测绘小程序，本人暑期编写，简单易用
C#白塞尔大地主题正算
06-13
椭球面点的大地经度 L、大地纬度 B，两点间的大地线长度 S 及其正、反大地方位角 A1、 A2 ,统称为大地元素,如图 1 所示。如果知道某些大地元素推求另外一些大地元素，这样的计算就叫做大地主题解算。 文档中包含数据格式(.txt) 运行程序(.exe) 开发文档(.doc) 以及报告格式(.txt) 附带c#可执行程序。
白塞尔大地主题反算
m0_57768434的博客
01-13 4545
算法原理： 已知两端点经纬度，反求大地线长度及正反大地方位角。 算法流程： 首先输入两端点经纬度，将角度转化为弧度参与后续计算。然后输入椭球参数（本次使用克氏椭球），计算辅助值。再用逐次趋近法同时计算起点大地方位角、球面长度及经差（第一次趋近时，取δ=0），直到最后两次δ小于限值（此处考虑到计算机省略小数点后几位的特性，直接令两者相等）。然后计算辅助系数，之后计算大底线长度，计算反方位角。 #include <iostream> #include<cmath> using
大地测量学白塞尔大地主题解算
何加焉的博客
06-03 9076
namespace 大地测量学1 { public partial class Form1 : Form { public Form1() { InitializeComponent(); } private void button1_Click(object sender, EventArgs e
C# 利用继承窗体实现贝塞尔大地问题正反算
weixin_38154901的博客
12-26 1233
先看看程序界面，比较简单，主窗体就是两个按钮。 单击正算按钮，主窗体隐藏，只显示正算窗体；关闭正算窗体，返回主窗体。 单击反算按钮，主窗体隐藏，只显示反算窗体；关闭反算窗体，返回主窗体。反算窗体继承自正算窗体。 程序运行过程中只显示一个窗体界面。 可选择不同的参考椭球进行计算，用户如有需要，可自行在代码中扩展椭球参数，扩展也非常方便 代码中重要的地方都有注释，下面是代码链接 ...
C#白塞尔大地正算
m0_68160088的博客
06-13 1268
白塞尔大地正反算 测绘工程
大地测量的C++代码
12-22
大地测量学的课程设计，包括平面坐标的正反算，空间坐标的正反算
白塞尔大地主题解算程序及源码
10-17
自己写的白塞尔大地主题解算程序及源码，包括正算与反算，编程语言为C++，小程序有可视化窗口，可作为测量学、大地测量学课程上机作业参考
正反算_大地主题解算_matlab_
10-02
使用MATLAB实现贝塞尔大地问题正反解计算
大地主题正反算
08-07
大地主题正反算程序源码，适用于测绘工程大地测量
白塞尔大地主题正算
m0_57768434的博客
01-13 4445
白塞尔大地主题正算，将椭球面上的大地元素按照白塞尔投影条件投影到辅助球面上，继而在球面上进行大地主题解算，最后再将球面上的计算结果换算到椭球面上。
大地线反算
qq_54401811的博客
07-27 241
【代码】大地线反算。
【亲测免费】 探索大地主题解算的利器：C白塞尔大地主题正算资源文件
最新发布
gitblog_09772的博客
10-31 462
探索大地主题解算的利器：C#白塞尔大地主题正算资源文件 去发现同类优质开源项目:https://gitcode.com/ 项目介绍 在地理信息系统（GIS）和大地测量领域，大地主题解算是一个至关重要的任务。它涉及在椭球面上，根据已知的大地元素（如大地经度、大地纬度、大地线长度及其正反大地方位角），推求其他大地元素。为了简化这一复杂过程，我们推出了“C#白塞尔大地主题正算资源文件”项目。该项目提供了...
评论 4
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值