-测绘程序设计实习报告

时间:2024.3.19

测绘程序设计(VB)

课间实习报告

姓名:__________________________

学号:__________________________

班级:__1141502_________________________

20##年10 月


1 实习目的... 3

2 实习仪器与软件... 3

2.1 Visual Basic 6.0. 3

3 实习要求... 4

4 实习内容... 4

5 实习步骤... 4

5.1 坐标正反算... 4

5.2 水准测量... 5

5.3 导线计算... 5

5.4 集成化设计... 5

6 实习总结... 5

6.1 实习问题总结... 5

6.2 程序调试总结... 5

7 附录... 5

7.1 正算代码... 5


测绘程序设计实习报告

1 实习目的

掌握Visual Basic(VB)程序设计的基本理论、方法和应用,掌握VB程序应用于测绘专业的程序开发,理解程序设计在测绘数据处理中的作用和地位,学会利用模块化程序设计的基本技术,掌握面向对象程序设计方法,应用测绘专业的基本技能,测绘专业模块程序包开发的基本方法,以及掌握一些最基本的知识,编程里面的英语以及函数有很多不知道,以至学习编程有点困难。、 对水准网观测高程间接平差理论内容的验证与应用。通过学习掌握测绘软件开发过程与方法,初步具备测绘软件开发基本技能。、实验原理和过程通过本学期对《测绘程序设计》课程的学习,编写一份综合性实验报告我选取的题目是利用vb语言进行编程。 熟悉程序设计任务书的基本内容,调查了解软件需求状况,进行需求分析,。计算机的基础比较差,要想将编程学好得掌握更多的函数以及专用的编程语言,工程测量运用编程来计算是比较普遍的,运用编程的方面也比较多,因此努力去掌握一些基础非常重要,为学习后续课程和专业技术工作打下基础。

2 实习仪器与软件

实习期间主要用到的软件有Visual Basic(VB),数据库软件Access、Office软件Word等。

2.1 Visual Basic 6.0

VB是美国microsoft公司在1991年推出的windouus环境下的软件开发工具。Visual意思为可视化的,指的是一种开发图形用户界面的方法。Basic是20世纪60年代出场的一门计算机程序语言,它以简单易学,使用方便的特点,得到广泛应用。VB语言是一种面向对象的可视化程序设计语言。这门语言进行简要的叙述,包括VB的开发环境,对象的概念以及编写VB应用程序的步骤。通过本章的学习,使读者对VB有个大致的了解,并能够编写一些简单的程序。VB使用了可以简单建立应用程序的GUI系统,但是又可以开发相当复杂的程序。VB的程序是一种基于窗体的可视化组件安排的联合,并且增加代码来指定组件的属性和方法。因为默认的属性和方法已经有一部分定义在了组件内,所以程序员不用写多少代码就可以完成一个简单的程序。过去的版本里面VB程序的性能问题一直被放在了桌面上,但是随着计算机速度的飞速增加,关于性能的争论已经越来越少。

VB是基于basic语言可视化程序设计语言。它继承了其先辈basic所具有的简单易用的特点,又采用了面向对象,事件驱动的编程机制,提够了一种所见及所得的可视化界面设计方法。   

VB使得大量的外界控件有了自己的生存空间。大量的第三方控件针对VB提供。VB也提供了建立、使用和重用这些控件的方法,但是由于语言问题,从一个应用程序创建另外一个并不简单。

。。。。。

3 实习要求

1.较为熟练地掌握VB程序设计与开发
  2.掌握测绘外业工作需要的一些基本理论与方法
  3.掌握测绘内业数据处理的流程
  4.掌握常用测绘专业软件的交换格式。

5  每次去机房首先找到与今天相关的程序进行调试

6  对程序的调试发挥自己所有的知识对程序进行编改

7 可以通过网络相结合找到一些相关的知识惊醒运用

8 每次将调试后的程序进行运行,如果没用继续调试,直到调试能够运行

9 如果实在不行可以以邮件形式进行询问

10 每次的作业以电子邮件的形式发

11 按时间交作业

4 实习内容

充分学习VB可视化编程以后,熟悉各种常用控件的使用。再结合测量专业数据处理,编写全部或部分专业程序。要求进行循序渐进的方式,先采用基本结构编写,在随后的课程学习当中,采用数组,函数,再生成数据文件格式,从低级到高级应用,最后通过窗体应用与函数的方法进行集成,将所有的实习最后集成到一个程序当中,使之进一步完善与改进等。

①  坐标正反算

坐标反算一般主要应用于测绘工程、建设工程之中,具体在建筑设计,工程测量,测绘制图等领域。总的来说坐标计算分为坐标正算和坐标反算两种,这两种在实际中是较常见的。所要求的公式为:

XB=XA+lcosaAB

YB=YA+lsinaAB

l= (XB-XA)²+(YB-YA)²

②  简易水准平差

平差公式=(闭合差/线路总长)*距离

③  交会测量程序

  交会测量(intersection survey)是根据多个已知点的平面坐标(或高程),通过测定已知点到某待定点的方向或(和)距离(或测定其竖直角),以推求此待定点平面坐标(或高程)的测量技术和方法。以确定待定点平面坐标为目的者,称平面交会测量;以确定待定点高程者,称高程交会测量;以确定待定点三维坐标的,称空间交会测量;若仅在已知点设站进行观测称前方交会,仅在待定点设站进行观测称后方交会既在待定点设站又在个别已知点设站进行观测称侧方交会。在平面和空问交会测量中,若经观测获得的仅有角元素称测角交会,而经观测获得的仅有边元素者称测边交会,经观测直接或间接获得的既有角元素又有边元素则称边角交会。在平面测角交会中,若控制点的平面位置是用解析法求得平面坐标值称解析交会,用图解法确定且直接展绘到图板上则称图解交会。[

4角度与弧度的转换

在python和Delphi中,牵涉到角度计算时,例如:sin(x),cos(x)等,这里的x都是弧度,而不是直接的角度。

因此,在计算对应角度的三角函数时,需要先将角度转换成弧度再计算。

弧度和角度的转换公式是:

角度=弧度*180.0f/PI

弧度=角度*PI/180.0f

(根据实际实习内容写)

5 实习步骤

实习主要在北区机房内进行,主要按实习内容进行

1要对每次的实习作业要进行早预习

2每次读应该对实习做一个充分的准备

3调试的程序一般在光盘上需要每次带好

4一到机房的第一件事情就是找到相关的程序,并进行观察以及查找什么地方能够进行改写

6对于调试一个程序就是讲程序改成最简单,不会很复杂

7对于调试好的程序接下来就是对界面的设计,界面需要整洁以及美观等等。调试好的程序哟按那个狗运行

8最后看程序是否能够运用一些数学函数来编写,那样能够使程序更加简易以及更加的的容易看

9最后就是将调试好的程序以电子邮件发送到邮箱时间在一周之内。

10实习完应该对之进行体会与思考,将知识掌握得跟好

5.1 坐标正反算

   坐标反算是根据已知点坐标,计算两点间距离和角度,正算公式为:

a为坐标方位角,S为两点的距离

公式分析:

   从式上可以知道公式需要知道初始始坐标,距离和角度,即需要四个输入,若需要在一个函数中实现,返回值有二个,可以有二种方法

1.    单个函数实现

Function Dis2xy(ByVal Dis as Double ,ByVal Ang as Double) as Double

利用数据返回

End Function

2.    两个函数实现

Function Dis2xy(ByVal Dis as Double,ByVal Ang as Double,ByVal Flag as Integer) as Double

增加参数控制

End Function

5.2 水准测量

水准测量又名“几何水准测量”,是用水准仪和水准尺测定地面上两点间高差的方法。在地面两点间安置水准仪,观测竖立在两点上的水准标尺,按尺上读数推算两点间的高差。通常由水准原点或任一已知高程点出发,沿选定的水准路线逐站测定各点的高程。由于不同高程的水准面不平行,沿不同路线测得的两点间高差将有差异,所以在整理国家水准测量成果时,须按所采用的正常高系统加以必要的改正,以求得正确的高程。

本节介绍水准测量成果的计算程序采用多窗口的方式组织,在主窗体上显示信息和执行各种操作,再输入窗口输入数据。方便主窗口与输入窗口的数据传递,本程序还是用了标准模块

水准路线依据工程的性质和测区情况,可以布设以下几种形式。

1  闭合水准路线

高程控制测量(即水准路线测量)分为闭合水准路线测量、附和水准路线测量和支水准路线测量。闭合水准路线测量有一个已知高程点,待测点分布成一个闭合环(所有点—已知高程点、待测点都在这个圈里,按序依次测量),即从已知点出发,到已知点结束。附和水准线路测量有两个已知点,待测点分布成一个弯折的线,从一个已知点出发,到另一个已知点结束(通常这两个已知点距离很远,甚至数十公里)。支水准路线测量往往依附于上面两种水准路线,作为布线死角的补充,有一个已知点,待测点数个成线状分布,从已知点出发,到最后一个待测点后,再原路返测(即往返侧)。闭合水准路线线路封闭,易于平差和纠错;特殊情况下可以做独立高程系统。

2 符合水准路线

附合水准路线是测量学的术语。从某个已知高程的水准点出发,沿路线进行水准测量,最后连测到另一已知高程的水准点上,这样的水准路线称为附合水准路线。

∑hHH (式中H与H分别表示最终点与起始已知点的高程)。

按高差闭合差的定义可知:

     fh∑h∑h∑h一(HH)                                  (3—12)

高差闭合差的允许值和校核要求与闭合水准路线相同。现以图3-20和表3-3中的观测数据为例来说明附合水准路线高差闭合差调整与高程计

∑hHH (式中H与H分别表示最终点与起始已知点的高程)。

按高差闭合差的定义可知:

     fh∑h∑h∑h一(HH)                                  (3—12)

高差闭合差的允许值和校核要求与闭合水准路线相同。

3  支水准路线

支水准路线是从一已知高级水准点出发,终点不附合于另一已知高级水准点的水准路线。.从给定的已知点出发,在已知点和ZDl间安置水准仪。立尺于已知点上,读取其后视读数,记入手簿相应栏内。立尺于ZDl的尺垫上,该取其前视读数,记入手簿相应栏内。至此,第一站观测完毕,计算第一站高差并记入手簿相应栏内;.ZDl尺垫不动,水准仪迁站,安置于ZD1和ZD2之间,依同法读取ZD1的后视读数和ZD2的前视读数,记入手簿相应栏内,并计算第二站的高差。依同法直至最后一站,读取并完成相应的记录和计算,以上为往测,计算往测的后视读数总和Σa、前视读数总和Σb和高差总和Σh,并进行计算检核,即Σa-Σb=Σh,应成立,依同法完成返程的观测、记录、计算及其检核。根据往、返测的高差计算高差闭合差fh,根据指导教师给定的单程水准路线长度L计算容许高差闭合差Fh。比较二者,若fh>Fh,表明未达到精度,应予重测,若fh Fh,表明达到精度,则在固定表格内计算高差最或是值并推算未知点的高程。注意事项1.照准目标应检查并消除视差;2.读数时,符合水准长气泡应严格居中;3.前、后视距离应大致相等(扶尺员可用步测);4.最大视线长度不得大于100 m;5.最小尺读数不得小于0.3m;6.在已知点和未知点上立尺时不得安放尺垫;

4  闭合差的计算

(1)闭合水准路线。闭合差为实测高差总合即:

f = ∑h测

(2)符合水准路线。闭合差为起点高程,中点高程差与实测高程总和之差,即:

f = ∑h测 ­­– (    h终-h始)

(3)支水准路线。闭合为往,放测量的高差代数和,即:

f=∑h往-∑h返

5  高差闭合差不超过一定的限度时,认为精度合格,成果可用。普通水准测量终容许高差闭合差一般规定为:

F容=+-40√l

F容==-12√n

式中 L- 水准路线长度,单位km

       n- 测站数

闭合差不超过限时,以距离为权分配闭合差。设整条线录长为L,莫段水准路线长为S

整条路线闭合差为f,则该站分配到的闭合差为:

H=-f*s/l

程序分析和设计

Public Sub AddData(iMark As Integer, dist, dH As Single)

    dis(iMark) = dist

    detH(iMark) = dH

End Sub

7  在闭合差符合要求的情况下,将闭合差以每一站的前后视距和为权进行分配,最后得出每一转点的高程。

5.3 导线计算

导线是将一系列测量控制点,依相邻次序连接而构成折线形式的平面控制图形。由一系列导线元素构成:导线点,是导线上的已知点和待定点;导线边,是连接导线点的折线边;导线角,指导线边之间所夹的水平角。与已知方向相连接的导线角称为连接角(亦称定向角)。导线角按其位于导线前进方向的左侧或右侧而分别称为左角或右角,并规定左角为正、右角为负;单一导线与导线网,其区别在于前者无结点,而后者具有结点。单一导线可布设成:附合导线,起始于一个已知点而终止于另一个已知点;闭合导线,起闭于同一个已知点;支导线,是从一个已知点出发,既不附合于另一个已知点,也不闭合于同一个已知点。导线网可布设为:附合导线网,具有一个以上已知点或具有其他附合条件;自由导线网,网中仅有一个已知点和一个起始方位角而不具有附合条件。

本节将介绍导线计算的程序设即方法,包括必和导线和符合导线的输入检查,容差计算和简易评查计算。本程序的界面采用主窗体和关于窗体的方式,主窗体上使用菜单来组织,数据的输入和输出都采用读写文件的方式来完成,数据的显示和提示信息在主窗体上的文本框中显示。

导线测量是道路及桥梁工程中常采用的一种控制布网方式,但由于受到施工现场的地形及环境限制,导线的布设方式就会有很大的随意性,这样就涉及到各种形式的导线平差计算问题。然而实际工作中所使用的大多数全站仪却只有支导线点的计算功能,这就给在施工现场进行导线测量的平差

1 导线的简易计算

将测区内相邻口指点连接成直线的折现,称为导线。这些控制点,称为导线点。导线测量就是一次侧定格导线边的长度和各折角值,根据起算数据推算各边的坐标方位角,从而求出个导线的坐标。

导线测量是建立小地区平面控制网常用的一种方法,特别是地物分布较复杂的建筑区,实现障碍较多的隐蔽区和带状地区,多采用导线测量的方法,通常分为一级导线,二级导线,三级导线和图更导线登几个等级。根据测区的不同情况和要求,导线可不设成必和导线复合导线一级无定向导线和支导线等级形式。本节介绍计算前两种导线的程序设计方法,后两种形式导线的计算留给读者完成。

(1)闭合导线。起讫于同一己知点的导线,称闭和导线

  闭合导线是导线测量的一种,根据测量夹角和边长,推算出平面坐标的测量称为导线测量,常用的导线测量还包括附和导线和支导线。闭合导线就是已知一条边,测量若干个边长和夹角后又闭合到已知边的导线测量方法。通过计算平差后,可计算得到经过的未知点的平面坐标。

  闭合导线平差计算步骤:

  1,绘制计算草图,在图上填写已知数据和测量数据。

  2,角度闭合差的计算与调整。

  3,按新的角值,计算各边坐标增量。

  4,坐标增量闭合差得计算与调整。

  5,根据坐标增量计算坐标。

(2)附合导线。布设在两已知点间的导线,称为附合导线

附合导线是导线测量的一种,通过测量夹角和边长计算点的平面坐标的方法称为导线测量,它还包括闭合导线和支导线。附合导线是由一个已知点出发开始测量,经过若干未知点,到达另一个已知点,然后通过平差计算得到未知点平面坐标的导线测量。

  附合导线平差的一般步骤:

  1,绘制计算草图,在图上填写已知数据和测量数据。

  2,角度闭合差的计算与调整。

  3,按新的角值,计算各边坐标增量。

  4,坐标增量闭合差得计算与调整。

  5,根据坐标增量计算坐标。

(3)闭合导线的计算

1角度闭合差的计算于调整:

∑b=(n-2)*180

由于观测角不可避免地含有误差,因此会产生角度闭合差:

Fb=∑b-∑b1

角度闭合差的容许值,说明电线的确定,图根导线规定为:

Fb==-40n1\2

若角度闭合差超过容许值,说明所测的角度不符合要求,应重新检测角度,若不超过,可将闭合差反符号平均分配到各个观测角中。改正之后内角和应为(n-2)*180,一座计算校队。2用改正值的导线左角或右角

5.4 集成化设计

  集成化设计是基于并行工程思想的设计,它利用现代信息技术把传统厂品设计过程中相对独立的阶段、活动及信息有效的结合起来,强调产品设计及其过程同时交叉进行,减少设计过程的多次反复,力求使产品开发人员在设计一开始就考虑到厂品整个生命周期中从概念形成到产品报废处理的所有因素,从而最大限度地提高设计效率、降低生厂成本的设计方法。

  集成化设计的一个重要特征是:详细用户界面设计的整体方法(即框架)要在初期进行开发和测试。这是以用户为中心的设计和其他单纯的递增技巧之间存在的重要差异。它确保此后各阶段中进行的递增式设计能够天衣无缝地适合框架,而且用户界面在外观、术语和概念上都能保持一致

6 实习总结

6.1 实习问题总

在这一段时间的实习中,学到一些关于程序调试的知识,但是有感觉到什么也没有学到一样,可能对于vb的知识不够好吧。反正学习vb也有两年了,说没有学到什么又不能,最起码对vb这个软件的了解熟了,并且对于一些简单的程序是能够编写出来,英雌我的体会就是不是没有学到,而是所做的练习较少以及实际操作少。我可能还有个原因是对电脑的基本知识也少,因此对于vb差的原因也归纳与以上几个方面。在编程过程中遇到了较多的问题,解决问题的过程是漫长而艰苦的,然而在问题得到解决的一刹那是很快乐。比如在调节一个程序的时候,当在你不经意的时候将一个能够运行的程序改成了另一种方法来运行,那么你的心里会感觉到无比的兴奋。即使你也不知道是怎么改来的,但这也体现了你的坚持以及一些基础,但是这样的事情也只是很不可能的事情,因此以后还要加强对vb的学习。

6.2 程序调试总结

1、设计模块和过程
(1)模块和过程是应用程序代码的框架,建立这样的框架是应进行慎密的多方面的考虑

(2)涉及术语
过程:包括Sub过程,Function过程和Property(属性)过程。是专门用于一个特定
进程 的一串语句,过程可以拥有一组参数,通过这些参数与程序的其他部分进
行通信,也可以返回一个值,供程序的其他部分使用。
Sub 过程:用关键字Sub 说明的一种过程,不返回任何值。
Function 过程:用关键字function 说明的一种过程,返回相应的值。
Property 过程:用关键字Property、Get、 Property Let 或 Property Set 说明的一种过程

(3) 观察是否出现了可以给过程分组的条件,然后就可以考虑为过程的分组,而创建新模通过创建专用模块,能增强模块的内聚力。模块的基本目的是创建相当独立的程序单元.

(4) 尽量使过程成为自成一体的独立过程,除了尽量使过程成为专用过程外,还应该尽量使之成为独立的过程。应该尽量减少过程之间的连接关系,方法之一是尽量减少全局变量和模块级变量创建专用过程指导原则。

(5)当某个过程被许多其他过程调用(并且因此 许多其他过程依赖于他)时,就说明它是个高度扇入的过程,这是件好事。高度扇入的过程通常是封装很好的过程,它支持代码复用的思路。如果一个过程要调用许多其他过程,而它又 是个高度扇出的过程,那么情况就不那么好了,高度扇出意味着该过程要依赖于许多其他过程才能完成它的工作。

(6)设计模块和过程要达到的目的

1. 创建更加容易调试和维护的过程,

2. 创建具有强大内聚力的模块,       3. 创建高度专用的过程,

4. 创建松散连接的过程               5. 尽量使过程具有独立性
6. 提高过程的扇入性                 7 . 降低过程的扇出性

(7)编程原则
 (1)使代码更加容易理解,使程序工程的调试和维护工作大大改观。
方法: (1) 给过程命名时应该大小写字母混合使用
(2) 定义过程名时不使用缩写
2、为每个过程赋予单个退出点
优点:使过程更像是黑箱。代码的执行从一个门进来,代码的退出则从另一个门出
因此产生的错误比较少,调试也不太难。
方法:在每个过程中创建一个PROC_EXIT标注。 在这个标注下面,放入所有必要的清除代码和一个
相应的Exit语句(Exit Sub、Exit Function和Exit Property)。
每当你需要退出该过程时,只需加上一个GoTo PROC_Exit,而不必直接调用Exit命令。
3、 为每个过程赋予明确定义的作用域
作用域:工程中的变量或过程的可视性。创建过程 时,始终都应显式地定义它的
作用域。
(8 用参数在过程之间传递数据
(1)应该尽量避免使用模块级变量。
(2)为了减少模块级变量和全局变量,方法之一是将数据作为参数在不同过程之间传递而不是让过程共享全局变量或模块级变量。
(3)为每个参数指定数据类型,创建带有参数的过程时,请务必将每个参数明确说明为一个特定的数据类型。
(4)根据情况传递数据ByVal或ByRef。
(5)始终要对数进行检验,决不要假设你的数据没有问题。
(6)当参数只接受较小的一组值时,请使用枚举值。(7)使用统一和直观明了的方式来调用过程
(8)应该避免省略call这种方法。
(9)调用Sub过程时始终都要使用Call关键字。通过使用Call关键字,更容易将Sub调用与Function调用区分开来
(10)对于调试后进行归纳总结,以助更好的学习v7 附录

7.1 正算代码

1 水准测量

        '累计高差和高差闭合差

   

            tDist = tDist + dis(i)

    Next i

  

    totalDetH = 0

    For i = 1 To nMarks                     '计算累计高差

        totalDetH = totalDetH + detH(i)

    Next i

    '计算闭合差

    startPoint = Val(txtStartPoint.Text)

    endPoint = Val(txtEndPoint.Text)

    If optAnnex.Value Then                  '附合水准

        closeDetH = (endPoint - startPoint) - totalDetH

    Else                                    '闭合水准和支水准

        closeDetH = -totalDetH

    End If

    '检查闭合差是否超限

    If closeDetH > 0.04 * Sqr(tDist) Then        '采用40*Sqr(L)来计算,单位是毫米

        MsgBox "闭合差超限,测量成果不合格!", , "闭合差超限"

        txtShowResult.Text = txtShowResult.Text & "闭合差超限,测量成果不合格!"

        Exit Sub

    Else

        MsgBox "闭合差合格,继续计算转点高程!", , "闭合差合格"

    End If

   

    Dim temp!

    temp = startPoint

    txtShowResult.Text = txtShowResult.Text & "平差后的高程为:" & vbCrLf

    For i = 0 To nMarks

        temp = temp + detH(i) + closeDetH * dis(i) / tDist

        txtShowResult.Text = txtShowResult.Text & "        (" & Str(i) & "):" & Str(Format(temp, "0.000")) & vbCrLf

    Next i

End Sub

Private Sub cmdExit_Click()

    End

End Sub

Private Sub cmdInput_Click()

    '检查输入的几个文本框:是否已经输入了

    If txtStartPoint.Text = "0" Then

        MsgBox "还没有输入起始点高程!"

        Exit Sub

    End If

    If txtEndPoint.Text = "0" And optAnnex.Value = True Then

        MsgBox "还没有输入终点高程!"

        Exit Sub

    End If

    If txtBMNum.Text = "0" And optAnnex.Value = True Then

        MsgBox "还没有输入测站数!"

        Exit Sub

    End If

   

    frmInput.Show

End Sub

Private Sub optAnnex_Click()

    txtEndPoint.Enabled = optAnnex.Value

End Sub

Private Sub optClose_Click()

    txtEndPoint.Enabled = Not optClose.Value

End Sub

Private Sub optSpur_Click()

    txtEndPoint.Enabled = Not optSpur.Value

End Sub

Private Sub txtStartPoint_LostFocus()

    If Not IsNumeric(txtStartPoint.Text) Then

        MsgBox "输入的高程含有非数字字符!"

        txtStartPoint.Text = ""

        txtStartPoint.SetFocus

        Exit Sub

    End If

    If Val(txtStartPoint.Text) > 5000 Or Val(txtStartPoint.Text) < -100 Then

        MsgBox "输入的高程有误!"

        txtStartPoint.Text = ""

        txtStartPoint.SetFocus

        Exit Sub

    End If

    startPoint = Val(txtStartPoint.Text)

End Sub

        MsgBox "输入的高程含有非数字字符!"

        txtEndPoint.Text = ""

        txtEndPoint.SetFocus

        Exit Sub

    End If

    If Val(txtEndPoint.Text) > 5000 Or Val(txtEndPoint.Text) < -100 Then

        MsgBox "输入的高程有误!"

        txtEndPoint.Text = ""

        txtEndPoint.SetFocus

        Exit Sub

    End If

    endPoint = Val(txtEndPoint.Text)

End Sub

Private Sub txtBMNum_LostFocus()

    If Not IsNumeric(txtBMNum.Text) Then

        MsgBox "输入的测站数含有非数字字符或尚未输入!"

        txtBMNum.Text = ""

        txtBMNum.SetFocus

        Exit Sub

    End If

    nMarks = Val(txtBMNum.Text)

    If txtBMNum.Text <> "" And (nMarks > 20 Or nMarks < 2) Then

        MsgBox "输入的测站数有误!"

        txtBMNum.Text = ""

        txtBMNum.SetFocus

        Exit Sub

    End If

    ReDim dis(nMarks) As Single, detH(nMarks) As Single

End Sub

   

     Xx2 = (k2 + 1) * (x2 * Cos(e2) + y2 * Sin(e2)) + dX2

     Yy2 = (k2 + 1) * (y2 * Cos(e2) - x2 * Sin(e2)) + dY2

   

      txtXx2.Text = Format(Xx2, "0.0000")

      txtYy2.Text = Format(Yy2, "0.0000")

   End Sub

  反算代码

   

     x2 = ((Xx2 - dX2) * Cos(e2) - (Yy2 - dY2) * Sin(e2)) / (k2 + 1)

     y2 = ((Yy2 - dY2) * Cos(e2) + (Xx2 - dX2) * Sin(e2)) / (k2 + 1)

   

      txtX2.Text = Format(x2, "0.0000")

      txtY2.Text = Format(y2, "0.0000")

   End Sub

3 导线计算代码

    If Check1.Value = 0 And Check2.Value = 0 Then

      MsgBox "请选择标尺", "1"

    End If

     Text7.Text = Val(Text5.Text) - Val(Text6.Text) '前距

   If Text7.Text > 500 Or Text7.Text < -500 Then

     MsgBox "后尺读数错误"

   End If

     Text3.Text = Val(Text1.Text) - Val(Text2.Text)  '后距

     If Text3.Text > 500 Or Text3.Text < -500 Then

      MsgBox "前尺读数错误"

     End If

     Text4.Text = (Val(Text3.Text) - Val(Text7.Text)) / 10 '视距差

    If Text4.Text > 30 Or Text4.Text < -30 Then

       MsgBox "数据超出误差"

    End If

     Text11.Text = Val(Text9.Text) - Val(Text10.Text)

     Text15.Text = Val(Text13.Text) - Val(Text14.Text) '后-前

     Text12.Text = Val(Text19.Text) + Val(Text9.Text) - Val(Text13.Text)

     Text16.Text = Val(Text20.Text) + Val(Text10.Text) - Val(Text14.Text) 'K+黑-红

 If Text12.Text > 3 Or Text12.Text < -3 Then

   MsgBox "中丝超出误差"

 End If

  If Text16.Text > 3 Or Text16.Text < -3 Then

    MsgBox "中丝超出误差"

  End If

     Text17.Text = Val(Text15.Text) + Val(Text21.Text) - Val(Text11.Text)

     Text18.Text = (Val(Text11.Text) + Val(Text15.Text) + Val(Text21.Text)) / 2 '高差中数

End Sub

4 矩阵的相加 相减 相乘的编程

Option Explicit

Public R1%, R2%, C1%, C2%               '两个输入矩阵的行数、列数

Public m%, n%, s%                       '进行运算的矩阵大小,相乘时两个矩阵为m×s和s×n,相加减、转置时矩阵大小为m×n

Public IsFirstMOperated As Boolean      '是否当前操作是对第一个矩阵进行

Public a() As Double, b() As Double, c() As Double  '存放两个被操作矩阵和结果矩阵

Public Sub GetMatrix()

    Dim i%, j%, k%

    If IsFirstMOperated Then

        frmMain.txtResult.Text = frmMain.txtResult.Text & "    第一个矩阵的内容为:" & vbCrLf

        For i = 1 To R1

            For j = 1 To C1

                a(i, j) = Val(frmInput.txt((i - 1) * C1 + j))

                frmMain.txtResult.Text = frmMain.txtResult.Text & Str(a(i, j)) & " , "

            Next j

            frmMain.txtResult.Text = frmMain.txtResult.Text & vbCrLf

        Next i

    Else

        frmMain.txtResult.Text = frmMain.txtResult.Text & "    第二个矩阵的内容为:" & vbCrLf

        For i = 1 To R2

            For j = 1 To C2

                b(i, j) = Val(frmInput.txt((i - 1) * C2 + j))

                frmMain.txtResult.Text = frmMain.txtResult.Text & Str(b(i, j)) & " , "

            Next j

            frmMain.txtResult.Text = frmMain.txtResult.Text & vbCrLf

        Next i

    End If

End Sub

Public Sub MatrixPlus()

 

        MsgBox "第一个矩阵尚未输入!"

        Exit Sub

    End If

    If R2 < 1 Or C2 < 1 Then

        MsgBox "第二个矩阵尚未输入!"

        Exit Sub

    End If

    If R1 <> R2 Or C1 <> C2 Then

        MsgBox "输入的两个矩阵维数不等,不能相加!"

        Exit Sub

    End If

    ReDim c(1 To m, 1 To n) As Double

    frmMain.txtResult.Text = frmMain.txtResult.Text & "    两个矩阵相加的结果为:" & vbCrLf

    For i = 1 To m

        For j = 1 To n

            c(i, j) = a(i, j) + b(i, j)

            frmMain.txtResult.Text = frmMain.txtResult.Text & Str(c(i, j)) & " , "

        Next j

        frmMain.txtResult.Text = frmMain.txtResult.Text & vbCrLf

'    On Error Resume Next

'    C1 = UBound(a, 2) - LBound(a, 2) + 1

'    If Err Then

'        MsgBox "第一个矩阵维数不对!"

'        Exit Sub

'    End If

'    On Error Resume Next

'    C2 = UBound(b, 2) - LBound(b, 2) + 1

'    If Err Then

'        MsgBox "第二个矩阵维数不对!"

'        Exit Sub

'    End If

'    R1 = UBound(a, 1) - LBound(a, 1) + 1

'    R2 = UBound(b, 1) - LBound(b, 1) + 1

'

'    If R1 <> R2 Or C1 <> C2 Then

'        MsgBox "输入的两个矩阵维数不等,不能相加!"

'End Sub

    If R1 < 1 Or C1 < 1 Then

        MsgBox "第一个矩阵尚未输入!"

        Exit Sub

    End If

    If R2 < 1 Or C2 < 1 Then

        MsgBox "第二个矩阵尚未输入!"

        Exit Sub

    End If

    If R1 <> R2 Or C1 <> C2 Then

        MsgBox "输入的两个矩阵维数不等,不能相减!"

        Exit Sub

    End If

    ReDim c(1 To m, 1 To n) As Double

    frmMain.txtResult.Text = frmMain.txtResult.Text & "    两个矩阵相减的结果为:" & vbCrLf

    For i = 1 To m

        For j = 1 To n

            c(i, j) = a(i, j) - b(i, j)

            frmMain.txtResult.Text = frmMain.txtResult.Text & Str(c(i, j)) & " , "

        Next j

        frmMain.txtResult.Text = frmMain.txtResult.Text & vbCrLf

    Next i

End Sub

''矩阵相减的通用过程

'Public Sub MatrixMinus(a, b, c)

'    Dim i%, j%

'    Dim R1%, C1%, R2%, C2%

'    On Error Resume Next

'    C1 = UBound(a, 2) - LBound(a, 2) + 1

'    If Err Then

'        MsgBox "第一个矩阵维数不对!"

'        Exit Sub

'    End If

'    On Error Resume Next

'    C2 = UBound(b, 2) - LBound(b, 2) + 1

'    If Err Then

'        MsgBox "第二个矩阵维数不对!"

'        Exit Sub

'    End If

'    R1 = UBound(a, 1) - LBound(a, 1) + 1

'    R2 = UBound(b, 1) - LBound(b, 1) + 1

'

'    If R1 <> R2 Or C1 <> C2 Then

'        MsgBox "输入的两个矩阵维数不等,不能相减!"

'        Exit Sub

'  

Public Sub MatrixMulti()

    Dim i%, j%, k%

    If R1 < 1 Or C1 < 1 Then

        MsgBox "第一个矩阵尚未输入!"

        Exit Sub

    End If

    If R2 < 1 Or C2 < 1 Then

        MsgBox "第二个矩阵尚未输入!"

        Exit Sub

    End If

    If C1 <> R2 Then

        MsgBox "输入的两个矩阵大小不对,不能相乘!"

        Exit Sub

    End If

    m = R1: s = C1: n = C2

    ReDim c(1 To m, 1 To n) As Double

    frmMain.txtResult.Text = frmMain.txtResult.Text & "    两个矩阵相乘的结果为:" & vbCrLf

   

                c(i, j) = c(i, j) + a(i, k) * b(k, j)

            Next k

            frmMain.txtResult.Text = frmMain.txtResult.Text & Str(c(i, j)) & " , "

        Next j

        frmMain.txtResult.Text = frmMain.txtResult.Text & vbCrLf

    Next i

End Sub

''矩阵相乘的通用过程

'Public Sub MatrixMulti(a, b, c)

'   '    '    On Error Resume Next

'    C1 = UBound(a, 2) - LBound(a, 2) + 1

'    If Err Then

'        MsgBox "第一个矩阵维数不对!"

'        Exit Sub

'    End If

'    On Error Resume Next

'    C2 = UBound(b, 2) - LBound(b, 2) + 1

'    If Err Then

'        MsgBox "第二个矩阵维数不对!"

'        Exit Sub

'    End If

'    R1 = UBound(a, 1) - LBound(a, 1) + 1

'    R2 = UBound(b, 1) - LBound(b, 1) + 1

'

'    If C1 <> R2 Then

'        MsgBox "输入的两个矩阵大小不对,不能相乘!"

'        Exit Sub

'    End If

'

'    m = R1: s = C1: n = C2

'   

'                c(i, j) = c(i, j) + a(i, k) * b(k, j)

'     

Public Sub MatrixTrans()

    If R1 < 1 Or C1 < 1 Then

        MsgBox "第一个矩阵尚未输入!"

    Else

        ReDim c(1 To C1, 1 To R1)

        For i = 1 To R1

            For j = 1 To C1

                c(j, i) = a(i, j)

            Next j

        Next i

        frmMain.txtResult.Text = frmMain.txtResult.Text & "    第一个矩阵转置的结果为:" & vbCrLf

        For i = 1 To C1

            For j = 1 To R1

                frmMain.txtResult.Text = frmMain.txtResult.Text & Str(c(i, j)) & " , "

            Next j

            frmMain.txtResult.Text = frmMain.txtResult.Text & vbCrLf

        Next i

    End If

    If R2 < 1 Or C2 < 1 Then

        MsgBox "第二个矩阵尚未输入!"

    Else

        ReDim c(1 To C2, 1 To R2)

        For i = 1 To R2

            For j = 1 To C2

                c(j, i) = b(i, j)

            Next j

        Next i

        frmMain.txtResult.Text = frmMain.txtResult.Text & "    第二个矩阵转置的结果为:" & vbCrLf

        For i = 1 To C2

            For j = 1 To R2

                frmMain.txtResult.Text = frmMain.txtResult.Text & Str(c(i, j)) & " , "

            Next j

            frmMain.txtResult.Text = frmMain.txtResult.Text & vbCrLf

        Next i

    End If

End Sub

''矩阵转置的通用过程

'Public Sub MatrixTrans(a, c)

'

'    On Error Resume Next

'    C1 = UBound(a, 2) - LBound(a, 2) + 1

'    If Err Then

'        MsgBox "输入的矩阵维数不对!"

'        Exit Sub

'    End If

'    R1 = UBound(a, 1) - LBound(a, 1) + 1

'    ReDim c(1 To C1, 1 To R1)

'    For i = 1 To R1

'        For j = 1 To C1

'            c(j, i) = a(i, j)

'  

单导线编程

'求AB的坐标方位角,输入是两点坐标,输出的是弧度值

Public Function DirectAB(Xa#, Ya#, Xb#, Yb#) As Double

    Dim detX#, detY#, tana#

    detX = Xb - Xa

    detY = Yb - Ya

    If Abs(detX) < 0.000001 Then

        If detY > 0 Then

            DirectAB = PI / 2

        Else

            DirectAB = PI * 3 / 2

        End If

    Else

        tana = detY / detX

        DirectAB = Atn(tana)

        If detX < 0 Then

            DirectAB = PI + DirectAB

        ElseIf detX > 0 And detY < 0 Then

            DirectAB = PI * 2 + DirectAB

        End If

    End If

End Function

'弧度化为度.分秒的形式:输入弧度值,输出度.分秒(各占两位)

Public Function HuToDo(ByVal Hu As Double) As Single

    Dim du%, fen%, miao%

   

    Hu = Hu * 180 / PI

   

    du = Fix(Hu)

    Hu = (Hu - du) * 60

    fen = Fix(Hu)

    Hu = (Hu - fen) * 60

    miao = Fix(Hu + 0.5)

    If miao = 60 Then

        fen = fen + 1

        miao = 0

 

    HuToDo = du + fen / 100 + miao / 10000

End Function

'将度.分秒形式化为弧度:输入为度.分秒形式,输出为弧度

Public Function DoToHu(ByVal DoFenMiao As Double) As Single

    Dim du%, 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

End Function

'矩阵转置的通用过程

Public Sub MatrixTrans(A, c)

    On Error Resume Next

    C1 = UBound(A, 2) - LBound(A, 2) + 1

    If Err Then

        MsgBox "输入的矩阵维数不对!"

        Exit Sub

    End If

    R1 = UBound(A, 1) - LBound(A, 1) + 1

    ReDim c(1 To C1, 1 To R1)

    For i = 1 To R1

        For j = 1 To C1

            c(j, i) = A(i, j)

        Next j

    Next i

End Sub

'矩阵相加的通用过程

Public Sub MatrixPlus(A, b, c)

    Dim i%, j%

    Dim R1%, C1%, R2%, C2%

    On Error Resume Next

    C1 = UBound(A, 2) - LBound(A, 2) + 1

    If Err Then

        MsgBox "第一个矩阵维数不对!"

        Exit Sub

    End If

    On Error Resume Next

    C2 = UBound(b, 2) - LBound(b, 2) + 1

    If Err Then

        MsgBox "第二个矩阵维数不对!"

        Exit Sub

    End If

    R1 = UBound(A, 1) - LBound(A, 1) + 1

    R2 = UBound(b, 1) - LBound(b, 1) + 1

    If R1 <> R2 Or C1 <> C2 Then

        MsgBox "输入的两个矩阵维数不等,不能相加!"

        Exit Sub

    End If

    ReDim c(1 To m, 1 To n) As Double

    For i = 1 To m

        For j = 1 To n

            c(i, j) = A(i, j) + b(i, j)

        Next j

    Next i

End Sub

'矩阵相减的通用过程

Public Sub MatrixMinus(A, b, c)

  

    C1 = UBound(A, 2) - LBound(A, 2) + 1

    If Err Then

        MsgBox "第一个矩阵维数不对!"

        Exit Sub

    End If

    On Error Resume Next

    C2 = UBound(b, 2) - LBound(b, 2) + 1

    If Err Then

        MsgBox "第二个矩阵维数不对!"

        Exit Sub

    End If

    R1 = UBound(A, 1) - LBound(A, 1) + 1

    R2 = UBound(b, 1) - LBound(b, 1) + 1

    If R1 <> R2 Or C1 <> C2 Then

        MsgBox "输入的两个矩阵维数不等,不能相减!"

        Exit Sub

    End If

    ReDim c(1 To m, 1 To n) As Double

    For i = 1 To m

        For j = 1 To n

            c(i, j) = A(i, j) - b(i, j)

        Next j

    Next i

End Sub

'矩阵相乘:输入矩阵或数Qa、Qb,自动识别它们的维数,并输出它们的乘积Qn

Public Sub Matrix_Multy(Qn, Qa, Qb)

    Dim ia%, ib%, ic%

    Dim ai%, bi%, ci%

    Dim e1 As Boolean, e2 As Boolean, e3 As Boolean, e4 As Boolean, e5 As Boolean, e6 As Boolean, e7 As Boolean

   

    On Error Resume Next '看Qa是不是一维数组

        ic = UBound(Qa, 2) - LBound(Qa, 2)

    If Err Then e1 = True

    On Error Resume Next '看Qa是不是一维数组

        ib = UBound(Qb, 2) - LBound(Qb, 2)

    If Err Then e2 = True

   

    If e1 = False And e2 = False Then '二维矩阵相乘

        For ai = LBound(Qa, 1) To UBound(Qa, 1)

            For bi = LBound(Qb, 2) To UBound(Qb, 2)

                For ci = LBound(Qa, 2) To UBound(Qa, 2)

                    Qn(ai, bi) = Qn(ai, bi) + Qa(ai, ci) * Qb(ci, bi)

                Next ci

            Next bi

        Next ai

    ElseIf e1 = True And e2 = False Then

        On Error Resume Next

            ia = UBound(Qa) - LBound(Qa)

        If Err Then e6 = True

       

        If e6 Then '数乘以二维矩阵

            For ai = LBound(Qb, 1) To UBound(Qb, 1)

                For bi = LBound(Qb, 2) To UBound(Qb, 2)

                    Qn(ai, bi) = Qa * Qb(ai, bi)

                Next bi

            Next ai

        Else '一维矩阵乘以二维矩阵

            For ci = LBound(Qb, 2) To UBound(Qb, 2)

                For ai = LBound(Qa, 1) To UBound(Qa, 1)

                    Qn(ci) = Qn(ci) + Qa(ai) * Qb(ai, ci)

                Next ai

            Next ci

        End If

    ElseIf e1 = False And e2 = True Then

        On Error Resume Next

            ic = UBound(Qb) - LBound(Qb)

        If Err Then e7 = True

       

        If e7 Then '二维矩阵乘以数

            For ai = LBound(Qa, 1) To UBound(Qa, 1)

                For bi = LBound(Qa, 2) To UBound(Qa, 2)

                    Qn(ai, bi) = Qa(ai, bi) * Qb

                Next bi

            Next ai

        Else '二维矩阵乘以一维矩阵

            For ai = LBound(Qa, 1) To UBound(Qa, 1)

                For bi = LBound(Qa, 2) To UBound(Qa, 2)

                    Qn(ai) = Qn(ai) + Qa(ai, bi) * Qb(bi)

                Next bi

            Next ai

        End If

    Else

        Dim errT As Integer

        On Error Resume Next '结果是否是一个数

            errT = UBound(Qn)

        If Err Then e3 = True

        If e3 Then '一维矩阵乘以一维矩阵得一个数

            For ai = LBound(Qa, 1) To UBound(Qa, 1)

                For bi = LBound(Qa, 2) To UBound(Qa, 2)

                    Qn = Qn + Qa(ai) * Qb(bi)

                Next bi

            Next ai

            Exit Sub

        End If

        

        On Error Resume Next '是否是数乘一维矩阵

            ia = UBound(Qa) - LBound(Qa)

        If Err Then e4 = True

        If e4 Then

            For bi = LBound(Qa, 2) To UBound(Qa, 2)

                Qn(bi) = Qa * Qb(bi)

            Next bi

            Exit Sub

        End If

        On Error Resume Next '是否是一维矩阵乘数

            ib = UBound(Qb) - LBound(Qb)

        If Err Then e5 = True

        If e5 Then

            For ai = LBound(Qa, 1) To UBound(Qa, 1)

                Qn(ai) = Qa(ai) * Qb

       

        

        '一维矩阵相乘结果是二维矩阵

            For ai = LBound(Qa, 1) To UBound(Qa, 1)

                For bi = LBound(Qa, 2) To UBound(Qa, 2)

                    Qn(ai, bi) = Qa(ai) * Qb(bi)

                Next bi

'矩阵相乘的通用过程

Public Sub MatrixMulti(A, b, c)

         On Error Resume Next

    C1 = UBound(A, 2) - LBound(A, 2) + 1

    If Err Then

        MsgBox "第一个矩阵维数不对!"

        Exit Sub

    End If

    On Error Resume Next

    C2 = UBound(b, 2) - LBound(b, 2) + 1

    If Err Then

        MsgBox "第二个矩阵维数不对!"

        Exit Sub

    End If

    R1 = UBound(A, 1) - LBound(A, 1) + 1

    R2 = UBound(b, 1) - LBound(b, 1) + 1

    If C1 <> R2 Then

        MsgBox "输入的两个矩阵大小不对,不能相乘!"

        Exit Sub

    End If

    m = R1: s = C1: n = C2

    ReDim c(1 To m, 1 To n) As Double

                   c(i, j) = c(i, j) + A(i, K) * b(K, j)

            Next K

        Next j

    Next i

End Sub

'列选主元法Guass约化求解线性方程组

Public Sub MajorInColGuass(A, b, X)

   

    '计算并检查矩阵的大小

    Row = UBound(A, 1) - LBound(A, 1) + 1

    Col = UBound(A, 2) - LBound(A, 2) + 1

    If Row <> Col Then

        MsgBox "方程组的系数矩阵有误!"

        Exit Sub

    End If

    '准备约化过程的变量和数组

    n = UBound(b) - LBound(b) + 1

    If n <> Row Then

        MsgBox "方程组的系数矩阵与常数项大小不符!"

        Exit Sub

    End If

    ReDim L(2 To Row) As Double

    Dim sumAX As Double, iPos%, temp#

    '约化过程

    For iStep = 1 To n - 1

        '列选主元

        iPos = 0

        For iRow = iStep + 1 To n

            If Abs(A(iRow, iStep)) > Abs(A(iStep, iStep)) Then

                iPos = iRow

            End If

        Next iRow

        If iPos > iStep Then    '需要换主元

            For iCol = iStep To n

                temp = A(iStep, iCol)

                A(iStep, iCol) = A(iPos, iCol)

                A(iPos, iCol) = temp

            Next iCol

            temp = b(iStep)

            b(iStep) = b(iPos)

            b(iPos) = temp

        End If

        '约化过程

        For iRow = iStep + 1 To n

            L(iRow) = A(iRow, iStep) / A(iStep, iStep)

            For iCol = iStep To n

                A(iRow, iCol) = A(iRow, iCol) - L(iRow) * A(iStep, iCol)

            Next iCol

            b(iRow) = b(iRow) - L(iRow) * b(iStep)

        Next iRow

        ShowMatrix A

    Next iStep

    '回代过程

    X(n) = b(n) / A(n, n)

    For iRow = n - 1 To 1 Step -1

        sumAX = 0

        For iCol = n To iRow + 1 Step -1

            sumAX = sumAX + A(iRow, iCol) * X(iCol)

        Next iCol

        X(iRow) = (b(iRow) - sumAX) / A(iRow, iRow)

    Next iRow

End Sub

'Guass-Seidel迭代法求解线性方程组

Private Function Seidel(A, b, X, eps#) As Boolean

    Dim i%, j%

    Dim P#, Q#, s#, t#

    Dim Row%, Col%, n%

    Row = UBound(A, 1) - LBound(A, 1) + 1

    Col = UBound(A, 2) - LBound(A, 2) + 1

    n = UBound(b) - LBound(b) + 1

    If n <> Row Then

        MsgBox "方程组的系数矩阵与常数项大小不符!"

        Exit Function

    End If

   

    For i = 1 To n

        P = 0#

        X(i) = 0#

        For j = 1 To n

            If i <> j Then P = P + Abs(A(i, j))

        Next j

        If P >= Abs(A(i, i)) Then

            Seidel = False

            Exit Function

        End If

    Next i

   

    P = eps + 1#

    While P >= eps

        P = 0#

        For i = 1 To n

            t = X(i)

            s = 0#

            For j = 1 To n

                If j <> i Then s = s + A(i, j) * X(j)

            Next j

           

            X(i) = (b(i) - s) / (A(i, i))

            Q = Abs(X(i) - t) '/ (1# + Abs(x(i)))

            If Q > P Then P = Q

        Next i

    Wend

   

    Seidel = True

End Function

Public Sub ShowMatrix(tt)

    Dim i%, j%, n%, m%

    m = UBound(tt, 1) - LBound(tt, 1) + 1

    n = UBound(tt, 2) - LBound(tt, 2) + 1

    For i = 1 To m

        For j = 1 To n

            Debug.Print tt(i, j),

        Next j

        Debug.Print

    Next i

End Sub

'通用的间接平差解算过程:输入系数矩阵A、权矩阵P、常数向量L和解向量X,求出X,并通过参数传出去

Public Sub InAdjust(A, P, L, X)

    Dim a1%, a2%, p1%, p2%, L1%, x1%    '输入矩阵或向量的大小

    Dim At() As Double, AtP() As Double, Naa#(), W() As Double  '几个中间矩阵

   

    '计算并检查输入矩阵或向量的大小

    On Error Resume Next

    a1 = UBound(A, 1) - LBound(A, 1) + 1

    If Err Then

        MsgBox "系数矩阵A大小错误!"

        Exit Sub

    End If

    On Error Resume Next

    a2 = UBound(A, 2) - LBound(A, 2) + 1

    If Err Then

        MsgBox "系数矩阵A大小错误!"

        Exit Sub

    End If

    On Error Resume Next

    L1 = UBound(L) - LBound(L) + 1

    If Err Then

        MsgBox "常数向量L大小错误!"

        Exit Sub

    End If

    On Error Resume Next

    x1 = UBound(X) - LBound(X) + 1

    If Err Then

        MsgBox "解向量X大小错误!"

        Exit Sub

    End If

    On Error Resume Next

    p1 = UBound(P, 1) - LBound(P, 1) + 1

    If Err Then

        MsgBox "权矩阵P大小错误!"

        Exit Sub

    End If

    On Error Resume Next

    p2 = UBound(P, 2) - LBound(P, 2) + 1

    If Err Then

        MsgBox "权矩阵P大小错误!"

        Exit Sub

    End If

    If p1 <> p2 Then

        MsgBox "权矩阵P不是方阵!"

        Exit Sub

    End If

    If p1 <> a1 Or p2 <> a1 Then

        MsgBox "权矩阵P与系数矩阵A大小不符!"

        Exit Sub

    End If

    If a2 <> x1 Then

        MsgBox "系数矩阵A大小与解向量X大小不符!"

        Exit Sub

    End If

    If a1 <> L1 Then

        MsgBox "系数矩阵A大小与常数向量L大小不符!"

        Exit Sub

    End If

   

    '定义中间矩阵的大小

    ReDim At(1 To a2, 1 To a1), AtP(1 To a2, 1 To a1)

    ReDim Naa(1 To a2, 1 To a2), W(1 To a2)

   

    '组成法方程并计算

    Debug.Print "The A matrix is:"

    ShowMatrix A

    MatrixTrans A, At               '求A的转置矩阵

    Debug.Print "The At matrix is:"

    ShowMatrix At

   

    Debug.Print "The P matrix is:"

    ShowMatrix P

    Matrix_Multy AtP, At, P         '求AtP

    Debug.Print "and The AtP matrix is:"

    ShowMatrix AtP

   

    Matrix_Multy Naa, AtP, A        '法方程系数矩阵

    Debug.Print "the Naa matrix is:"

    ShowMatrix Naa

   

    Debug.Print "the L matrix is:"

    For x1 = LBound(L) To UBound(L)

        Debug.Print L(x1)

    Next x1

    Matrix_Multy W, AtP, L          '法方程常数向量

    Debug.Print "the W matrix is:"

    For x1 = LBound(W) To UBound(W)

        Debug.Print W(x1)

    Next x1

   

    MajorInColGuass Naa, W, X

    Debug.Print "the X matrix is:"

    For x1 = LBound(X) To UBound(X)

        Debug.Print X(x1)

    Next x1

    'Seidel Naa, W, x, 0.000001

End Sub

'通用的条件平差解算过程:输入系数矩阵A、权矩阵P、常数向量L和解向量X,求出X,并通过参数传出去

Public Sub CondiAdjust(b, P, W, V)

    Dim b1%, b2%, p1%, p2%, w1%, v1%    '输入矩阵或向量的大小

    Dim Q#(), Bt#(), QBt#(), Nbb#(), K#(), i% '几个中间矩阵

   

    '计算并检查输入矩阵或向量的大小

    On Error Resume Next

    b1 = UBound(b, 1) - LBound(b, 1) + 1

    If Err Then

        MsgBox "系数矩阵B大小错误!"

        Exit Sub

    End If

    On Error Resume Next

    b2 = UBound(b, 2) - LBound(b, 2) + 1

    If Err Then

        MsgBox "系数矩阵B大小错误!"

        Exit Sub

    End If

    On Error Resume Next

    w1 = UBound(W) - LBound(W) + 1

    If Err Then

        MsgBox "常数向量W大小错误!"

        Exit Sub

    End If

    On Error Resume Next

    v1 = UBound(V) - LBound(V) + 1

    If Err Then

        MsgBox "改正数向量V大小错误!"

        Exit Sub

    End If

    On Error Resume Next

    p1 = UBound(P, 1) - LBound(P, 1) + 1

    If Err Then

        MsgBox "权矩阵P大小错误!"

        Exit Sub

    End If

    On Error Resume Next

    p2 = UBound(P, 2) - LBound(P, 2) + 1

    If Err Then

        MsgBox "权矩阵P大小错误!"

        Exit Sub

    End If

    If p1 <> p2 Then

        MsgBox "权矩阵P不是方阵!"

        Exit Sub

    End If

    If p1 <> b2 Then

        MsgBox "权矩阵P与系数矩阵A大小不符!"

        Exit Sub

    End If

    If b2 <> v1 Then

        MsgBox "系数矩阵B大小与解向量V大小不符!"

        Exit Sub

    End If

    If b1 <> w1 Then

        MsgBox "系数矩阵B大小与常数向量W大小不符!"

        Exit Sub

    End If

   

    '定义中间矩阵的大小

    ReDim Bt(1 To b2, 1 To b1), QBt(1 To b2, 1 To b1)

    ReDim Nbb(1 To b1, 1 To b1), K(1 To b1), Q(1 To p1, 1 To p2)

   

    '组成法方程并计算

    For i = 1 To p1             '求Q矩阵

        Q(i, i) = 1 / P(i, i)

5  坐标转换的编程

Option Explicit

Dim k2#, e2#, dX2#, dY2#                    '尺度参数、旋转参数、两个平移参数

Dim x2#, Xx2#, y2#, Yy2#                    '二维坐标变换的正反数值

Dim k3#, Ex#, Ey#, Ez#, dX3#, dY3#, dZ3#    '尺度参数、三个旋转参数、三个平移参数

Dim X3#, Y3#, Z3#, Xx3#, Yy3#, Zz3#         '三维坐标转换的正算数值

Const PI = 3.14159265358979

Private Sub Check1_Click()

    If Check1.Value = 1 Then

        frmCoorTrans.Height = 5175

    ElseIf Check1.Value = 0 Then

        frmCoorTrans.Height = 4440

    End If

End Sub

  Open txtFileName.Text For Input As #1

        Line Input #1, s

        n = Val(s)

        ReDim x1#(n), y1#(n), x2#(n), y2#(n)

        For i = 1 To n

            Line Input #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)

        Next i

    Close #1

   

    '计算转换参数

    ReDim A(1 To 2 * n, 1 To 4) As Double, L(1 To 2 * n) As Double

    ReDim At(1 To 4, 1 To 2 * n), Naa(1 To 4, 1 To 4), W(1 To 4)

   

    Debug.Print "系数矩阵A:"

    For i = 1 To n                              '组成系数矩阵和常数向量

        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)

        Debug.Print 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)

        Debug.Print 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)

    Next i

    Debug.Print "常数向量L:"

    For i = 1 To 2 * n

        Debug.Print L(i)

    Next i

   

    MatrixTrans A, At                   '求系数阵的转置矩阵

    Debug.Print "A的转置矩阵:"

    ShowMatrix At

   

    Matrix_Multy Naa, At, A             '求AtA

    Debug.Print "Naa:"

    ShowMatrix Naa

   

    Matrix_Multy W, At, L               '求AtL

    Debug.Print "W:"

    For i = 1 To 4

        Debug.Print W(i)

    Next i

   

    MajorInColGuass Naa, W, x           'Guass约化法解线性方程组

    Debug.Print "X"

    For i = 1 To 4

        Debug.Print x(i)

    Next i

    '分离旋转和尺度参数

    If Abs(x(3)) < 0.00000001 Then

        If x(4) > 0 Then

            e2 = PI / 2

        Else

            e2 = PI * 3 / 2

        End If

更多相关推荐:
测绘毕业实习报告

毕业实习报告姓名:XX学号:XXX班级:测绘0802班指导老师:XX院系:测绘与国土信息工程学院实习单位:河南红旗区建设集团河南红旗渠建设集团焦作体育馆项目实习报告四年的大学生活转眼就要结束了,通过三年多的学习…

测绘专业实习-实习报告

课程编号课程性质必修数字测图实习数字测图实习报告学院专业测绘工程地点三校区大花岭班级20xx16103组号姓名学号教师20xx年12月日至20xx年12月日目录1实习目的32实习意义33测区概况34实习任务45...

测绘实习报告

辽宁工程技术大学本科生实习报告书教学单位测绘与地理科学专业建筑工程系班级096学生姓名学号指导教师李兰勇12345678911实习报告结构111目录目录要层次清晰给出标题及层次111前言或引言前言不编标题序号1...

测绘专业毕业实习报告-

淮海工学院实习报告书题目毕业实习学院测绘工程学院专业测绘工程班级测绘082姓名学号20xx年4月1日1目录1引言111实习名称112实习目的113实习时间与单位地点114实习项目简介215实习项目安排22测区概...

测绘综合实习报告

古建筑测绘综合实习报告记湘潭市文庙配殿东厢一实习目的通过对古建筑民居街巷等建筑的测绘实习增强对中国传统建筑经验的感性认识深刻理解和灵活运用在课堂上所学的多方面的基本理论知识亲手将建筑实物按比例绘制成工程图进一步...

测绘实习报告

数字测图技术实习报告实习地点云南国土资源职业学院阳宗海校区起止日期20xx年3月3日至30日班级12级工程测量与监理2班姓名王云芳学号11120xx201目录第一部分前言1第二部分实习内容2第三部分实习总结3第...

建筑测绘实习报告

建筑测绘实习报告学年学期学院城市建设与安全工程专业班级建筑学组成员王晓云1110520xx2实习日期20xx623711沈涛1110520xx3小建筑测绘实习报告一实习目的通过这次实习我们可以从实践中学习建筑建...

地形图测绘实习 实习报告 模板

地理信息与旅游学院地形图测绘实习实习总结报告地理信息与旅游学院实习总结报告实习名称地形图测绘实习姓名杨秋凤班级测绘122学号20xx210396谷双喜指导老师实习时间12月23日至12月29日评定成绩地理信息与...

古建测绘实习报告

古建测绘实习报告一相关说明1时间20xx年08月21日20xx年08月27日2地点四川省南充市阆中古镇3带队老师钟运锋黄岩4小组成员常晓敏冉丹丹雷雯李鹏博高扬崔江张晓波王彬伋赵朋飞5测绘点贡院前院6贡院介绍清代...

测绘C程序设计实习报告

测绘程序设计C版实习报告学号姓名班级专业测绘工程课程名称C程序及其测绘应用指导老师20xx年12月目录1实习目的错误未定义书签2实习内容错误未定义书签21实习环境错误未定义书签22实习主要内容介绍错误未定义书签...

测绘工程专业生产实习报告

测绘工程生产实习报告班级测绘20xx1专本汾西姓名左晓花学号001121390中国矿业大学成人教育学院目录TOCoquot13quotu第一章绪言1一实习的目的1二实习的要求1三实习的内容1四实习内容的时间分配...

20xx测量学实习报告

20xx测量学实习报告第1篇测量学实习报告实习时间20XX年xx月xx日至20xx年xx月xx日实习地点1地形图测绘实习地点湖北省武汉市江夏区豹澥镇龙泉山地区2地形图识图实习地点湖北省武汉市江夏区豹澥镇花山地区...

测绘实习报告(45篇)