水准网平差(VB代码)

合集下载

测绘程序设计—实验八-水准网平差程序设计报告

《测绘程序设计()》上机实验报告（Visual C++.Net）班级: 测绘0901班学号: **********姓名: 代娅琴4月29日实验八平差程序设计基础一、实验目旳•巩固过程旳定义与调用•巩固类旳创立与使用•巩固间接平差模型及平差计算•掌握平差程序设计旳基本技巧与环节二、实验内容水准网平差程序设计。

设计一种水准网平差旳程序, 规定数据从文献中读取, 计算部分与界面无关。

水准网间接平差模型:计算示例:近似高程计算:1.水准网平差计算一般环节(1)读取观测数据和已知数据；(2)计算未知点高程近似值；(3)列高差观测值误差方程；(4)根据水准路线长度计算高差观测值旳权；(5)构成法方程；(6)解法方程, 求得未知点高程改正数及平差后高程值；(7)求高差观测值残差及平差后高差观测值；(8)精度评估；(9)输出平差成果。

2.水准网高程近似值计算算法3.输入数据格式示例实验代码:#pragma onceclass LevelControlPoint{public:LevelControlPoint(void);~LevelControlPoint(void);public:CString strName;//点名CString strID;//点号float H;bool flag;//标记与否已经计算出近似高程值, 若计算出则为, 否则为};class CDhObs{public:CDhObs(void);~CDhObs(void);public:LevelControlPoint* cpBackObj;//后视点LevelControlPoint* cpFrontObj;//前视点double ObsValue;//高差值double Dist;//测站旳距离};#include"StdAfx.h"#include"LevelControlPoint.h"LevelControlPoint::LevelControlPoint(void){strName=_T("");strID=_T("");H=0;flag=0;}LevelControlPoint::~LevelControlPoint(void){}CDhObs::CDhObs(void){}CDhObs::~CDhObs(void){}#pragma once#include"LevelControlPoint.h"#include"Matrix.h"class AdjustLevel{public:AdjustLevel(void);~AdjustLevel(void);public:LevelControlPoint* m_pKnownPoint;//已知点数组int m_iKnownPointCount;//已知点个数LevelControlPoint* m_pUnknownPoint;//未知点数组int m_iUnknownPointCount;//未知点个数CDhObs* m_pDhObs;//高差观测值数组int m_iDhObsCount;//高差观测值个数public:void SetKnownPointSize(int size);//创立大小为size旳已知点数组void SetUnkonwnPointSize(int size);//创立大小为size旳未知点数组void SetDhObsSize(int size);//创立大小为size旳观测值数组bool LoadObsData(const CString& strFile);//读入观测文献CString* SplitString(CString str, char split, int& iSubStrs);void ApproHeignt(void);//计算近似值private:LevelControlPoint* SearchKnownPointUsingID(CString ID);LevelControlPoint* SearchUnknownPointUsingID(CString ID);LevelControlPoint* SearchPointUsingID(CString ID);CMatrix LevleWeight(void);//计算权矩阵public:void FormErrorEquation(CMatrix &B, CMatrix &L);//构成误差方程void EquationCompute(CMatrix &x);//计算法方程void Accuracy_Assessment(double &r0,CMatrix &Qxx);//精度评估void CompAdjust(double &r0,CMatrix Qx[]);};#include"StdAfx.h"#include"AdjustLevel.h"#include<locale.h>#include"LevelControlPoint.h"#include"math.h"AdjustLevel::AdjustLevel(void){m_pKnownPoint=NULL;//已知点数组m_iKnownPointCount=0;//已知点个数m_pUnknownPoint=NULL;//未知点数组m_iUnknownPointCount=0;//未知点个数m_pDhObs=NULL;//高差观测值数组m_iDhObsCount=0;//高差观测值个数}AdjustLevel::~AdjustLevel(void){if(m_pKnownPoint!=NULL){delete[] m_pKnownPoint;m_pKnownPoint=NULL;}if(m_pUnknownPoint!=NULL){delete[] m_pUnknownPoint;m_pUnknownPoint=NULL;}if(m_pDhObs!=NULL){delete[] m_pDhObs;m_pDhObs=NULL;}}void AdjustLevel::SetKnownPointSize(int size){m_pKnownPoint=new LevelControlPoint[size];//创立动态指针m_iKnownPointCount=size;}void AdjustLevel::SetUnkonwnPointSize(int size){m_pUnknownPoint=new LevelControlPoint[size];m_iUnknownPointCount=size;}void AdjustLevel::SetDhObsSize(int size){m_pDhObs=new CDhObs[size];m_iDhObsCount=size;//高差观测值个数}bool AdjustLevel::LoadObsData(const CString& strFile){CStdioFile sf;if(!sf.Open(strFile,CFile::modeRead)) return false;//创立并打开文献对象CString strLine;bool bEOF=sf.ReadString(strLine);//读取第一行, 即已知点旳数目SetKnownPointSize(_ttoi(strLine));//根据已知点旳数目, 创立已知点数组；int n=0;for(int i=0;i<m_iKnownPointCount;i++)//读取已知点旳点名和高程值{sf.ReadString(strLine);CString *pstrData=SplitString(strLine,',',n);m_pKnownPoint[i].strName=pstrData[0];m_pKnownPoint[i].strID=pstrData[0];m_pKnownPoint[i].H=_tstof(pstrData[1]);m_pKnownPoint[i].flag=1;//已知点不用平差, 故将其旳flag设立为delete[] pstrData;pstrData=NULL;}sf.ReadString(strLine);//读取未知点旳个数SetUnkonwnPointSize(_ttoi(strLine));//根据未知点旳个数创立未知点数组sf.ReadString(strLine);//读取未知点旳点名CString *pstrData=SplitString(strLine,',',n);for(int i=0;i<m_iUnknownPointCount;i++)//将未知点旳点名放入未知点数组{m_pUnknownPoint[i].strName=pstrData[i];m_pUnknownPoint[i].strID=pstrData[i];m_pUnknownPoint[i].H=0;//未知点旳高程值设立为m_pUnknownPoint[i].flag=0;//还没有求得近似高程, 故其flag设立为}if(pstrData!=NULL){delete[] pstrData;pstrData=NULL;}sf.ReadString(strLine);//读取观测值旳个数SetDhObsSize(_ttoi(strLine));//按照观测值旳大小, 创立观测值数组for(int i=0;i<m_iDhObsCount;i++)//分行读取观测值旳数据, 将其存入观测值数组{sf.ReadString(strLine);CString *pstrData=SplitString(strLine,',',n);m_pDhObs[i].cpBackObj=SearchPointUsingID(pstrData[0]);//后视点m_pDhObs[i].cpFrontObj=SearchPointUsingID(pstrData[1]);//前视点m_pDhObs[i].HObsValue=_tstof(pstrData[2]);//高差观测值m_pDhObs[i].Dist=_tstof(pstrData[3]);//距离观测值delete[] pstrData;pstrData=NULL;}sf.Close();return 1;}CString* AdjustLevel::SplitString(CString str, char split, int& iSubStrs) {int iPos = 0; //分割符位置int iNums = 0; //分割符旳总数CString strTemp = str;CString strRight;//先计算子字符串旳数量while (iPos != -1){iPos = strTemp.Find(split);if (iPos == -1){break;}strRight = strTemp.Mid(iPos + 1, str.GetLength());strTemp = strRight;iNums++;}if (iNums == 0) //没有找到分割符{//子字符串数就是字符串自身iSubStrs = 1;return NULL;}//子字符串数组iSubStrs = iNums + 1; //子串旳数量= 分割符数量+ 1CString* pStrSplit;pStrSplit = new CString[iSubStrs];strTemp = str;CString strLeft;for (int i = 0; i < iNums; i++){iPos = strTemp.Find(split);//左子串strLeft = strTemp.Left(iPos);//右子串strRight = strTemp.Mid(iPos + 1, strTemp.GetLength());strTemp = strRight;pStrSplit[i] = strLeft;}pStrSplit[iNums] = strTemp;return pStrSplit;}//LevelControlPoint* AdjustLevel::SearchKnownPointUsingID(CString ID) {for(int i=0;i<m_iKnownPointCount;i++){if(m_pKnownPoint[i].strID==ID){return &m_pKnownPoint[i];}}return NULL;}//LevelControlPoint* AdjustLevel::SearchUnknownPointUsingID(CString ID) {for(int i=0;i<m_iUnknownPointCount;i++){if(m_pUnknownPoint[i].strID==ID){return &m_pUnknownPoint[i];}}return NULL;}LevelControlPoint* AdjustLevel::SearchPointUsingID(CString ID){LevelControlPoint* cp;cp=SearchKnownPointUsingID(ID);if(cp==NULL)cp=SearchUnknownPointUsingID(ID);return cp;}void AdjustLevel::ApproHeignt(void)//用于计算高程近似值旳函数{for(int i=0;i<m_iUnknownPointCount;i++)//计算未知点高程值{if(m_pUnknownPoint[i].flag!=1){//先在未知点作为观测值旳前视点旳状况for(int j=0;j<m_iDhObsCount;j++)//从观测数组里找与未知点有关联旳点{//如果观测值旳前视点是未知点且其后视点已有高程值if((m_pDhObs[j].cpFrontObj->strID==m_pUnknownPoint[i].strID)&& m_pDhObs[j].cpBackObj->flag==1 ){ //前视点=后视点-高差/*m_pUnknownPoint[i].H=m_pDhObs[i].cpBackObj->H -m_pDhObs[i].ObsValue;*/m_pUnknownPoint[i].H=m_pDhObs[j].cpBackObj->H + m_pDhObs[j].HObsValue;m_pUnknownPoint[i].flag=1;break;}}if(m_pUnknownPoint[i].flag!=1)//如果通过上一环节未知点仍没有计算出近似值{for(int j=0;j<m_iDhObsCount;j++)//从观测数组里找与未知点有关联旳点 {//如果观测值旳后视点是未知点且其前视点已有高程值if((m_pDhObs[j].cpBackObj->strID==m_pUnknownPoint[i].strID)&& m_pDhObs[j].cpFrontObj->flag==1 ){ //后视点=前视点+高差m_pUnknownPoint[i].H=m_pDhObs[j].cpFrontObj->H-m_pDhObs[j].HObsValue;/*m_pUnknownPoint[i].H=m_pDhObs[i].cpFrontObj->H+m_pDhObs[i].ObsValue;*/m_pUnknownPoint[i].flag=1;break;}}}}if(i==m_iUnknownPointCount-1)//如果已经计算到最后一种未知点{for(int a=0;a<m_iUnknownPointCount;a++){if(m_pUnknownPoint[i].flag!=1)//只要有一种未知点旳近似高程直没有计算{ //则要重新进行上面旳环节直到所有旳未知点旳近似高程值都计算出i=-1;break;}}}}}CMatrix AdjustLevel::LevleWeight(void){CMatrix p(m_iDhObsCount,m_iDhObsCount);p.Unit();double value;for(int i=0;i<m_iDhObsCount;i++){value=(1.0/m_pDhObs[i].Dist);p(i,i)=value;}return p;}void AdjustLevel::FormErrorEquation(CMatrix &B, CMatrix &L){B.SetSize(m_iDhObsCount,m_iUnknownPointCount);L.SetSize(m_iDhObsCount,1);for(int i=0;i<m_iDhObsCount;i++)//建立B系数阵{LevelControlPoint *tmpBack=NULL,*tmpFront=NULL;tmpBack=SearchPointUsingID(m_pDhObs[i].cpBackObj->strID);tmpFront=SearchPointUsingID(m_pDhObs[i].cpFrontObj->strID);//找到与第i个观测值有关旳未知点tmpBack->strID;for(int j=0;j<m_iUnknownPointCount;j++){if(m_pUnknownPoint[j].strID==tmpBack->strID)//如果是后视点则前面旳系数为-1{ B(i,j)=-1;continue;}if(m_pUnknownPoint[j].strID==tmpFront->strID)//如果是前视点则前面旳系数为{B(i,j)=1;}}}//建立L矩阵CString tmp;for(int i=0;i<m_iDhObsCount;i++){//l=高差观测值-（后视近似值-前视近似值）/*L(i,0)=m_pDhObs[i].ObsValue-(m_pDhObs[i].cpBackObj->H-m_pDhObs[i].cpFrontObj->H);*/ L(i,0)=m_pDhObs[i].HObsValue-(m_pDhObs[i].cpFrontObj->H -m_pDhObs[i].cpBackObj->H);tmp.Format(_T("%.3f"),L(i,0));L(i,0)=_tstof(tmp);L(i,0)=L(i,0)*1000;//将单位化为mm}}void AdjustLevel::EquationCompute(CMatrix &x)//计算法方程{CMatrix P,B,l;P=LevleWeight(); //P为权矩阵FormErrorEquation(B,l);ApproHeignt();CMatrix BT(m_iUnknownPointCount,m_iDhObsCount);BT=~B; //B旳转置矩阵CMatrix NBB(m_iUnknownPointCount,m_iUnknownPointCount);NBB=BT*P*B;CMatrix NBBl=NBB.Inv();x=NBBl*BT*P*l;for(int i=0;i<m_iUnknownPointCount;i++){m_pUnknownPoint[i].H+=x(i,0);//未知点高程值=近似值+改正数}}void AdjustLevel::Accuracy_Assessment(double &r0,CMatrix &Qxx)//精度评估{CMatrix B,l,P,x;P=LevleWeight(); //P为权矩阵FormErrorEquation(B,l);EquationCompute(x);CMatrix v(m_iDhObsCount,1);v=B*x-l;CMatrix vT(1,m_iDhObsCount);vT=~v;CMatrix r/*(1,l)*/;r=vT*P*v;r0=sqrt(r(0,0)/(m_iDhObsCount-m_iUnknownPointCount));//单位权中误差Qxx.SetSize(m_iUnknownPointCount,m_iUnknownPointCount);CMatrix BT(m_iUnknownPointCount,m_iDhObsCount);BT=~B;CMatrix NBB(m_iUnknownPointCount,m_iUnknownPointCount);NBB=BT*P*B;Qxx=NBB.Inv();}void AdjustLevel::CompAdjust(double &r0,CMatrix Qx[]){ApproHeignt();//计算未知点旳近似高程值并且存入数组CMatrix P(m_iDhObsCount,m_iDhObsCount);P=LevleWeight();//p为权矩阵CMatrix B,L;CMatrix x,Qxx;FormErrorEquation(B,L);//构成误差方程, B为系数矩阵, l为常数项EquationCompute(x);//计算法方程Accuracy_Assessment(r0,Qxx);//精度评估for(int i=0;i<m_iUnknownPointCount;i++)//未知点高程中误差{Qx[i]=sqrt(Qxx(i,i))*r0;}}#include"Matrix.h"#include"locale.h"#include"LevelControlPoint.h"#include"AdjustLevel.h"AdjustLevel LevelComput;CString* SplitString(CString str, char split, int& iSubStrs){int iPos = 0; //分割符位置int iNums = 0; //分割符旳总数CString strTemp = str;CString strRight;//先计算子字符串旳数量while (iPos != -1){iPos = strTemp.Find(split);if (iPos == -1){break;}strRight = strTemp.Mid(iPos + 1, str.GetLength());strTemp = strRight;iNums++;}if (iNums == 0) //没有找到分割符{//子字符串数就是字符串自身iSubStrs = 1;return NULL;}//子字符串数组iSubStrs = iNums + 1; //子串旳数量= 分割符数量+ 1CString* pStrSplit;pStrSplit = new CString[iSubStrs];strTemp = str;CString strLeft;for (int i = 0; i < iNums; i++){iPos = strTemp.Find(split);//左子串strLeft = strTemp.Left(iPos);//右子串strRight = strTemp.Mid(iPos + 1, strTemp.GetLength());strTemp = strRight;pStrSplit[i] = strLeft;}pStrSplit[iNums] = strTemp;return pStrSplit;}void CIndircLelveDlg::OnBnClickedOpendatafile(){// TODO: 在此添加控件告知解决程序代码UpdateData(TRUE);CFileDialog dlgFile(TRUE,_T("txt"),NULL,OFN_ALLOWMULTISELECT|OFN_EXPLORER,_T("(文本文献)|*.txt"));//创立文献对话框if(dlgFile.DoModal()==IDCANCEL) return;//如果选择取消按钮则返回CString strFileName=dlgFile.GetPathName();//打开获取文献文献名setlocale(LC_ALL,""); //设立语言环境CStdioFile sf;if(!sf.Open(strFileName, CFile::modeRead)) return;InputContent.Empty();//清空字符串str_openContent中旳内容CString strLine;BOOL bEOF=sf.ReadString(strLine);//读取第一行数据while(bEOF)//开始读取顶点数据{bEOF=sf.ReadString(strLine);if(bEOF)InputContent+=strLine+_T("\r\n");}sf.Close();UpdateData(FALSE);}void CIndircLelveDlg::OnBnClickedSavedata(){// TODO: 在此添加控件告知解决程序代码U pdateData(TRUE);CFileDialog dlgFile(FALSE,_T("txt"),NULL,OFN_EXPLORER,_T("(Level格式)|*.txt"));if(dlgFile.DoModal()==IDCANCEL) return;CString strFileName=dlgFile.GetPathName();setlocale(LC_ALL,"");CStdioFile sf;if(!sf.Open(strFileName, CFile::modeCreate|CFile::modeWrite)) return;sf.WriteString(LevleContent);sf.Close();UpdateData(FALSE);}void CIndircLelveDlg::OnBnClickedComputelevel(){// TODO: 在此添加控件告知解决程序代码UpdateData(TRUE);setlocale(LC_ALL,"");double *Qx=new double[LevelComput.m_iUnknownPointCount];double r0;pAdjust(r0,Qx);LevleContent.Format(_T("平差后高程值:\r\n"));CString Temp;for(int i=0;i<LevelComput.m_iUnknownPointCount;i++){Temp.Empty();Temp.Format(_T("%s,%.4f\r\n"),LevelComput.m_pUnknownPoint[i].strID,LevelComput.m_pUnknownPoint[i].H);LevleContent+=Temp;}Temp.Format(_T("单位权中误差: %.1f mm\r\n"),r0*1000);LevleContent+=Temp;LevleContent+=_T("未知点高程中误差(mm):\r\n");for(int i=0;i< LevelComput.m_iUnknownPointCount;i++){Temp.Empty();Temp.Format(_T("%s,%.1f\r\n"),LevelComput.m_pUnknownPoint[i].strName,Qx[i]*1000);LevleContent+=Temp;}UpdateData(false);}void CIndircLelveDlg::OnBnClickedSavelevleresult(){// TODO: 在此添加控件告知解决程序代码UpdateData(TRUE);CFileDialog dlgFile(FALSE,_T("txt"),NULL,OFN_EXPLORER,_T("(Level格式)|*.txt"));if(dlgFile.DoModal()==IDCANCEL) return;CString strFileName=dlgFile.GetPathName();setlocale(LC_ALL,"");CStdioFile sf;if(!sf.Open(strFileName, CFile::modeCreate|CFile::modeWrite)) return;sf.WriteString(LevleContent);sf.Close();UpdateData(FALSE);}三、实验成果打开文献数据:平差成果:四、实验心得这从实验是我们测绘程序设计旳最后一次实验, 虽然这个学期我们做了好几次有关旳实验, 但是我却发现自己学旳东西也越来越模糊, 感觉诸多内容都不理解。

VB测量平差程序设计讲稿

Case 0 '读入观测值文件Text1.Visible = FalseCommonDialog1.ShowOpenfname = CommonDialog1.FileName '将用户在"打开"对话框中选择的文件名对变量fname赋值If fname <> "" Then '若无此判断当对话框中选择取消时、下面赋值语句将出错Set ts = fso.OpenTextFile(fname) '将fname作为文本文件打开,并设置句柄j = 0: k = 0: p = 0: h = 0'j是测站数累计变量,k是已知点累计变量,l（j）、ns（j）分别是方向值、边长累积计数Do While ts.AtEndOfLine <> True '前测型循环，进入循环的条件是没有读到文件结束尾B = ts.ReadLine '读一行，置入bB = Trim(B): i = 1: '删除B可能有的前导和尾随空格，i是工作变量，m(i) = InStr(B, ",") '查行中第一个逗号的左数位置,并保存在整形数组变量m(i)Do While m(i) <> 0 '前测型Do... Loop循环，成立条件是该行字符串中有逗号tr(i) = Mid(B, m(i - 1) + 1, m(i) - m(i - 1) - 1) '提取指定位置开始的指定数目字符。

i = i + 1m(i) = InStr(m(i - 1) + 1, B, ",") '从上一个找到的逗号位置起，查找下一个逗号的位置LoopIf m(i) = 0 And i > 1 Then tr(i) = Right(B, Len(B) - m(i - 1)) '处理一行中最后一个逗号后的字符串'以下部分是将存储在数组变量m(i)中的字符分类存放到方向、边长、已知坐标、网型信息等数组中If p = 0 Then '读到的是文件第一行。

基于MATLAB的水准网和测边网平差程序设计

基于MATLAB的水准网和测边网平差程序设计摘要MATLAB是目前在研究机构广泛应用的一种数值计算及图形工具软件，它的特点是语法结构简明、数值计算高效、图形功能完备，特别适合非专业编程员完成数值计算、科学试验处理等任务。

以往的测量数据处理方法需要编制特定的处理矩阵运算程序，而且程度复杂，难度大。

本文介绍一种基于MATLAB的水准网和测边网的程序设计方法，与其它算法语言相比，具有编程简单，运算速度快的特点。

文中分别阐述了水准网和测边网程序的理论基础、实现步骤和运行结果。

通过实例的分析，总结出利用MATLAB对测量数据处理有很大的应用价值，它缩短了编程的时间，提高工作效率。

关键词：MATLAB；水准网；测边网；程序设计ABSTRAC TMATLAB is one species of numerical-values calculation and graphic tools software which is widely used to apply at research institutions at present. The particularities are: concise grammar-structure、highly efficient in numerical values calculating、complete function of graphs、especially it is adapted to evildoing professional programmer to accomplish the tasks that are numerical-values calculating and scientific experiments treating. The ancient methods of measured data-processing need establishing special proceedings of treating matrices operation, moreover, it is complex and greatly difficult.This article introduces one programming method dealing with leveling and measuring edge network based on MATLAB. Compared with other algorithm language, it has particularities which are simply programming and quickly operating. The article separately expatiate the theories basics、realizing steps and running results at leveling and measuring edge network. With the analysis of examples, it has prodigious application value in measured data-processing by use of MATLAB. Moreover, it shortens programming time and improves working effectiveness.Key words：MATLAB；leveling network；measuring edge network；programming目录绪论 (4)1. MATLAB软件简介 (5)2．MATLAB 在测量平差中的应用 (6)2.1测量平差原理的概述 (6)2.2平差程序总体方案 (7)3.1程序的功能 (8)3.2水准模型网的间接平差 (8)3.2.1 “权”值的确定 (8)3.2.2 水准路线的平差计算 (9)3.2.3 精度评定 (11)3.3水准网间接平差程序信息设计 (11)3.4 水准网程序与使用说明 (12)3.4.1 水准网程序流程图 (12)3.4.2 水准网程序的使用 (12)3.5案例 (13)4. 测边网平差程序设计 (15)4.1数学模型 (15)4.1.1 误差方程和法方程的组成 (15)4.1.2 边长观测的权 (15)4.1.3 解算法方程 (16)4.1.4 精度评定 (19)4.2 测边网平差信息设计 (20)4.2.1 主要的技术要求 (21)4．3利用MATLAB的绘图语句绘制网图 (21)4.4测边网程序和使用说明 (22)4.5 程序代码说明： (23)4.6程序的使用算例 (25)结论 (29)致谢 (30)参考文献 (31)附录一 (32)附录二 (36)附录三 (46)绪论作为一名测量技术人员，如果不掌握一门PC机编程语言与便携计算工具，要想提高测量工作的效率几乎寸步难行。

利用MATLAB实现水准网条件平差

０
Ｐ２ｈ６
（）Ｋ代入法方程式，出Ｖ值，４将求并求出平差值＝ＶＬ＋。（）５为了验证平差计算的正确性，用平差值重新列出平差值条件方程式，看是否满足方程。
Ａ
ｈ７
２水准网
Ｐ１
铜
业
工
程
２０Ｎ４０８０
是＝，＝Ｑ
＝５。因各观测高差不相关故
协因数阵为对角阵，：即
１７．２．３
Ｑ＝Ｐ＝～
２．７
２４．
１４．
１６．
由此组成法方程为：
ｒ．５２２４．２４．０１７．
强的绘图功能。ＭＴＡＡＬＢ集科学计算、图像处理、声
音处理于一身，一个高度的集成系统，良好的用是有户界面，并有良好的帮助功能。利用ＭＡＬＢ的矩ＴＡ
水准网中，必要观测的个数等于网中所有未知点个
数减ｌ。以图１中水准网为例详细说明水准网平差方程的列立和计算的具体过程，Ａ，Ｂ是已知高程的水准点，图中Ｐ，Ｐ，Ｐｌ２３点是待定点。Ａ，Ｂ是已
摘
要：水准网条件平差中矩阵运算占很大一部分，计算工作浪费时间较多。ＭＡＬＢ具有强大的矩阵运算ＴＡ
和创建图形厨户界面的功能。用ＭＡＬＢ编制水准网条件平差程序可以去掉矩阵计算这个沉重的包袱，而提高ＴＡ从
计算工作效率。
关键词：测量平；阵运算；ＴＡ；ＭＡＬＢ水准网

水准网平差(VB代码)

误差理论与测量平差础）课程设计报告系（部）：土木工程系实习单位：山东交通学院班级：测绘084学生姓名：田忠星学号080712420带队教师：夏小裕﹑周宝兴时间：10 年12 月13 日到10 年12 月19 日山东交通学院目录：1.摘要P32.概述P33.水准网间接平差程序设计思路P3—P44.平差程序流程图P4—P65.程序源代码及说明P7—P236.计算结果P23—P267.总结P26—P27一：摘要在测量工作中，为了能及时发现错误和提高测量成果的精度，常作多余观测，这就产生了平差问题。

在一个平差问题中，当所选的独立参数X?的个数等于必要观测数t 时，可将每个观测值表达成这t 个参数的函数，组成观测方程，这种以观测方程为函数模型的平差方法，就是间接平差。

二：概述：该课程设计的主要目是对水准网进行间接平差，在输入数据后依次计算高程近似值﹑误差方程和平差计算。

三：水准网间接平差程序设计思路1．根据平差问题的性质，选择t 个独立量（既未知点的高程）作为参数X?2.将每一个观测量的平差值（既观测的高程差值）分别表达成L L V3．由误差方程系数 B 和自由项组成法方程，法方程个数等于参数的个数t ；4. 解算法方程，求出参数X?,计算参数（高程）的平差值X?=X0 +x? ；5．由误差方程计算V，求出观测量（高差）平差值L L V 6.评定精度单位权中误差平差值函数的中误差四：平差程序流程图1．已知数据的输入需要输入的数据包括水准网中已知点数﹑未知点数以及这些点的点号，已知高程和高差观测值﹑距离观测值。

程序采用文件方式进行输入，约定文件输入的格式如下：第一行：已知点数﹑未知点数﹑观测值个数第二行：点号（已知点在前，未知点在后）第三行：已知高程（顺序与上一行的点号对应）第四行：高差观测值，按“起点点号，终点点号。

高差观测值，距离观测值”的顺序输入。

本节中使用的算例的数据格式如下2,3,7 1,2,3,4,5 5.016,6.016 1,3,1.359,1.11,4,2.009,1.7 2,3,0.363,2.3 2,4,1.012,2.7 3,4,0.657,2.4 3,5,0.238,1.4 5,2,-0.595,2.6 2.平差计算过程V TPV rV TPVnus（1）近似高程的计算。

vb水准

导线测量平差水准测量平差VB程序导线测量, 水准测量, 程序符合导线平差程序如下：Const pi As Double = 3.14159265358979 Private Sub Command1_Click() Form8.Hide mj = Val(Text1.Text) If list1.Text = "等精度" Then ma = Val(Text2.Text) mb = Val(Text3.Text) End If If Opt1.Value Then ij = 1 ElseIf Opt2.V alue Then ij = Val(Text4.Text) End If CommonDialog1.ShowOpen On Error GoTo errorhandler Open CommonDialog1.FileName For Input As #1 If Form8.Caption = "闭合导线" Then Input #1, bi1, bi2 End If Dim a1() Do n1 = n1 + 1 ReDim Preserve a1(1 To n1) Input #1, a1(n1) Loop Until Left(a1(n1), 1) = "*" n1 = (n1 - 1) / 3 ReDim Preserve a1(1 To 3 * n1) Dim c() Do t = t + 1 ReDim Preserve c(1 To t) Input #1, c(t) Loop Until Left(c(t), 1) = "*" t = t - 1 ReDim Preserve c(1 To t) Dim b1() If list1.Text = "等精度" Then '等精度时，取角度和距离观测值Do n2 = n2 + 1 ReDim Preserve b1(1 To n2) Input #1, b1(n2) Loop Until Left(b1(n2), 1) = "*" n2 = (n2 - 1) / 4 ReDim Preserve b1(1 To 4 * n2) Dim d1() Do While Not EOF(1) n3 = n3 + 1 ReDim Preserve d1(1 To n3) Input #1, d1(n3) Loop n3 = n3 / 3 ElseIf list1.Text = "不等精度" Then '不等精度时，取角度和距离观测值以及中误差Dim b5() Do n2 = n2 + 1 ReDim Preserve b1(1 To 4 * n2), b5(1 To n2) Input #1, b1(4 * n2 - 3), b1(4 * n2 - 2), b1(4 * n2 - 1), b1(4 * n2), b5(n2) Loop Until Left(b1(4 * n2 - 3), 1) = "*" Dim d4() ReDim d1(1 To 3), d4(1 To 1) d1(1) = b1(4 * n2 - 2): d1(2) = b1(4 * n2 - 1) d1(3) = b1(4 * n2): d4(1) = b5(n2) n2 = n2 - 1 ReDim Preserve b1(1 To 4 * n2), b5(1 To n2) n3 = n3 + 1 Do While Not EOF(1) n3 = n3 + 1 ReDim Preserve d1(1 To 3 * n3), d4(1 To n3) Input #1, d1(3 * n3 - 2), d1(3 * n3 - 1), d1(3 * n3), d4(n3) Loop End If Close #1 n6 = 0 Dim ax1() If Form8.Caption = "附有条件的导线网" Then '如是附有条件的导线，取条件CommonDialog1.ShowOpen Open CommonDialog1.FileName For Input As #2 Do While Not EOF(2) n6 = n6 + 1 ReDim Preserve ax1(1 To n6) Input #2, ax1(n6) Loop n6 = n6 / 4 Close #2 End If For i = 1 To n2 If b1(4 * i - 3) Like b1(4 * i - 2) Or b1(4 * i - 3) Like b1(4 * i - 1) Or b1(4 * i - 2) Like b1(4 * i - 1) Then MsgBox "角度观测中，第" & i & "行存在重复点名！", , "错误" Exit Sub End If Next For i = 1 To n3 If d1(3 * i - 2) Like d1(3 * i - 1) Then MsgBox "边长观测中，第" & i & "行存在重复点名！", , "错误" Exit Sub End If Next Dim b11(), d11() ReDim b11(1 To 4 * n2), d11(1 To 3 * n3) For i = 1 To n2 For i1 = 1 To t If b1(4 * i - 3) Like c(i1) Then b11(4 * i - 3) = i1 + n1 GoTo 1 End If Next For i1 = 1 To n1 If b1(4 * i - 3) Like a1(3 * i1 - 2) Then b11(4 * i - 3) = i1 GoTo 1 End If Next int8 = MsgBox("角度观测中，第" & i & "行存在错误测站点" & b1(4 * i - 3) & "！", , "错误！") If int8 = vbOK Then Exit Sub 1: For i1 = 1 To t If b1(4 * i - 2) Like c(i1) Then b11(4 * i - 2) = i1 + n1 GoTo 2 End If Next For i1 = 1 To n1 If b1(4 * i - 2) Like a1(3 * i1 - 2) Then b11(4 * i - 2) = i1 GoTo 2 End If Next int8 = MsgBox("角度观测中，第" & i & "行存在错误后视点" & b1(4 * i - 2) & "！", , "错误！") If int8 = vbOK Then Exit Sub 2: For i1 = 1 To t If b1(4 * i - 1) Like c(i1) Then b11(4 * i - 1) = i1 + n1 GoTo 3 End If Next For i1 = 1 To n1 If b1(4 * i - 1) Like a1(3 * i1 - 2) Then b11(4 * i - 1) = i1 GoTo 3 End If Next int8 = MsgBox("角度观测中，第" & i & "行存在错误前视点" & b1(4 * i - 1) & "！", , "错误！") If int8 = vbOK Then Exit Sub 3: b11(4 * i) = b1(4 * i) Next For i = 1 To n3 For i1 = 1 To t If d1(3 * i - 2) Like c(i1) Then d11(3 * i - 2) = i1 + n1 GoTo 4 End If Next For i1 = 1 To n1 If d1(3 * i - 2) Like a1(3 * i1 - 2) Then d11(3 * i - 2) = i1 GoTo 4 End If Next int8 = MsgBox("边长观测中，第" & i & "行存在错误点" & d1(3 * i - 2) & "！", , "错误！") If int8 = vbOK Then Exit Sub 4: For i1 = 1 To t If d1(3 * i - 1) Like c(i1) Then d11(3 * i - 1) = i1 + n1 GoTo 5 End If Next For i1 = 1 To n1 If d1(3 * i - 1) Like a1(3 * i1 - 2) Then d11(3 * i - 1) = i1 GoTo 5 End If Next int8 = MsgBox("边长观测中，第" & i & "行存在错误点" & d1(3 * i - 1) & "！", , "错误！") If int8 = vbOK Then Exit Sub 5: d11(3 *i) = d1(3 * i) Next Dim x0() If Form8.Caption = "附合导线" Then ReDim x0(1 To 2 * t + 2) x0() = 附合导线(a1(), b11(), d11(), t) fx = x0(2 * t + 1) '坐标闭合差fy = x0(2 * t + 2) fs = Sqr(fx * fx + fy * fy) fx = Format(fx * 100, "0.0") fy = Format(fy * 100, "0.0") s = 0 For i = 1 To n3 '全长相对闭合差s = s + d1(3 * i) Next fs = Int(s / fs) For i = 1 To n2 '方位闭合差If b11(4 * i - 3) <= n1 And b11(4 * i - 2) <= n1 Then i1 = b11(4 * i - 3): i2 = b11(4 * i - 2) x1 = a1(3 * i1 - 1): y1 = a1(3 * i1) x2 = a1(3 * i2 - 1): y2 = a1(3 * i2) aq = xlu(x2, y2, x1, y1) ElseIf b11(4 * i - 3) <= n1 And b11(4 * i - 1) <= n1 Then i1 = b11(4 * i - 3): i2 = b11(4 * i - 1) x1 = a1(3 * i1 - 1): y1 = a1(3 * i1) x2 = a1(3 * i2 - 1): y2 = a1(3 * i2) az = xlu(x1, y1, x2, y2) End If bb = bb + hu(b1(4 * i)) Next bb = (aq + bb - n2 * pi - az) * 206264.806247096 bb = Format(bb, "0.00") bb1 = mj * Sqr(n2) bb1 = Format(bb1, "0.00") ReDim Preserve x0(1 To 2 * t) ElseIf Form8.Caption = "闭合导线" Then ReDim x0(1 To 2 * t + 2) x0() = 附合导线(a1(), b11(), d11(), t) fx = x0(2 * t + 1) '坐标闭合差fy = x0(2 * t + 2) fs = Sqr(fx * fx + fy * fy) fx = Format(fx * 100, "0.0") fy = Format(fy * 100, "0.0") s = 0 For i = 1 To n3 s = s + d1(3 * i) Next fs = Int(s / fs) For i = 1 To n2 bb = bb + hu(b1(4 * i)) Next If bi1 = 0 Then '方位闭合差If bi2 = 0 Then bb = (bb - (n2 - 2) * pi) * 206264.806247096 ElseIf bi2 = 1 Then bb = (bb - (n2 + 2) * pi) * 206264.806247096 End If ElseIf bi1 = 1 Then For i = 1 To n2 If b11(4 * i - 3) <= n1 And b11(4 * i - 2) <= n1 Then i1 = b11(4 * i - 3): i2 = b11(4 * i - 2) x1 = a1(3 * i1 - 1): y1 = a1(3 * i1) x2 = a1(3 * i2 - 1): y2 = a1(3 * i2) aq = xlu(x2, y2, x1, y1) End If Exit For Next If bi2 = 0 Then bb = (bb - aq - (n2 - 3) * pi) * 206264.806247096 ElseIf bi2 = 1 Then bb = (bb - aq - (n2 + 1) * pi) * 206264.806247096 End If End If bb1 = mj * Sqr(n2) bb1 = Format(bb1, "0.00") ReDim Preserve x0(1 To 2 * t) ElseIf Form8.Caption = "导线网平差" Then ReDim ax1(0) ReDim x0(1 To 2 * t) x0() = 导线网(a1(), b11(), d11(), ax1(), t) Else ReDim x0(1 To 2 * t) x0() = 导线网(a1(), b11(), d11(), ax1(), t) End If mj1 = mj For ii = 1 To ij Dim b2(), l2(), p() ReDim Preserve b2(1 To n2, 1 To 2 * t), l2(1 To n2), p(1 To n2 + n3) l2() = 角常系数1(a1(), b11(), x0()) b2() = 方系数2(a1(), b11(), x0()) Dim b3(), l3() ReDim b3(1 To n3, 1 To 2 * t), l3(1 To n3) b3() = 边系数2(a1(), d11(), x0()) l3() = 边常数项1(a1(), d11(), x0()) Dim b(), l() ReDim Preserve b(1 To n2 + n3, 2 * t), l(1 To n2 + n3) For j = 1 To 2 * t For i = 1 To n2 If b2(i, j) = "" Then b2(i, j) = 0 End If b(i, j) = 10 ^ 4 * b2(i, j) / 206264.806247096 If list1.Text = "等精度" Then p(i) = 1 ElseIf list1.Text = "不等精度" Then p(i) = mj1 * mj1 / (b5(i) * b5(i)) End If l(i) = 10 ^ 4 * l2(i) / 206264.806247096 Next For i = 1 To n3 If b3(i, j) = "" Then b3(i, j) = 0 End If b(i + n2, j) = b3(i, j) If list1.Text = "等精度" Then p(i + n2) = 2350.4 * mj1 * mj1 / ((ma + mb * d1(3 * i) / 1000) * (ma + mb * d1(3 * i) / 1000)) ElseIf list1.Text = "不等精度" Then p(i + n2) = 2350.4 * mj1 * mj1 / (d4(i) * d4(i)) End If l(i + n2) = l3(i) Next Next If Form8.Caption = "附有条件的导线网" Then '如是附有条件的导线，计算系数Dim ax(), lx() ReDim ax(1 To 2 * t, 1 To n6), lx(1 To n6) For i = 1 To n6 For i1 = 1 To n1 If ax1(4 * i - 3) Like a1(3 * i1 - 2) Then x1 = a1(3 * i1 - 1): y1 = a1(3 * i1) GoTo 111 End If Next i1 = i1 - 1 For i2 = 1 To t If ax1(4 * i - 3) Like c(i2) Then x1 = x0(2 * i2 - 1): y1 = x0(2 * i2) GoTo 111 End If Next 111: For i3 = 1 To n1 If ax1(4 * i - 2) Like a1(3 * i3 - 2) Then x1 = a1(3 * i3 - 1): y1 = a1(3 * i3) GoTo 112 End If Next i3 = i3 - 1 For i4 = 1 To t If ax1(4 * i - 2) Like c(i4) Then x2 = x0(2 * i4 - 1): y2 = x0(2 * i4) GoTo 112 End If Next 112: ss1 = Sqr((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2)) x3 = x2 - x1: y3 = y2 - y1 If ax1(4 * i) = 0 Then '如是方位角时，计算系数lx(i) = 10000 * (xlu(x1, y1, x2, y2) - hu(ax1(4 * i - 1))) If ax1(4 * i - 3) <> a1(3 * i1 - 2) Then ax(2 * i2 - 1, i) = 10000 * y3 / (ss1 * ss1) ax(2 * i2, i) = -10000 * x3 / (ss1 * ss1) End If If ax1(4 * i - 2) <> a1(3 * i3 - 2) Then ax(2 * i4 - 1, i) = -10000 * y3 / (ss1 * ss1) ax(2 * i4, i) = 10000 * x3 / (ss1 * ss1) End If ElseIf ax1(4 * i) = 1 Then '如是距离，计算系数lx(i) = ss1 - ax1(4 * i - 1) If ax1(4 * i- 3) <> a1(3 * i1 - 2) Then ax(2 * i2 - 1, i) = -x3 / ss1: ax(2 * i2, i) = -y3 / ss1 End If If ax1(4 * i -2) <> a1(3 * i3 - 2) Then ax(2 * i4 - 1, i) = x3 / ss1: ax(2 * i4, i) = y3 / ss1 End If End If Next Fori = 1 To 2 * t For j = 1 To n6 If ax(i, j) = "" Then ax(i, j) = 0 End If Next Next End If Dim u(), nni(), xx(), nni1() ReDim u(1 To 2 * t), nni(1 To t * (2 * t + 1)) nni() = 法系数(b(), p()) u() = 常数项(b(), p(), l()) If Form8.Caption = "附有条件的导线网" Then ReDim nni1(1 To (2 * t + n6) * (2 * t + n6 + 1) / 2) nni1() = 附有条件的法方程(nni(), ax()) ReDim Preserve u(1 To 2 * t + n6) For i = 1 To n6 u(2 * t + i) = lx(i) Next nni1() = ni(nni1(), 2 * t + n6) xx() = bx(nni1(), u()) ReDim Preserve xx(1 To 2 * t) nni() = 条件从有到无(nni1(), t, n6) Else nni() = ni(nni(), 2 * t) xx() = bx(nni(), u()) End IfFor i = 1 To 2 * tx0(i) = x0(i) + xx(i)NextDim v(), fz()ReDim v(1 To n2 + n3), fz(1 To 2 * t)v() = 改正数(b(), xx(), l())Dim v1(), v2()ReDim v1(1 To n2), v2(1 To n3)For i = 1 To n2v1(i) = v(i) * 206264.806247096 / 10000m1 = m1 + v1(i) * v1(i)Nextm1 = Sqr(m1 / (n2 - 1)): m1 = Format(m1, "0.00")For i = 1 To n3v2(i) = v(i + n2)Nextmm0 = 单位权中误差(v(), p())mm0 = Sqr(mm0 / (n2 + n3 - 2 * t + n6))m0 = mm0 * 206264.806247096 / 10000If Optd2.Value Thenmj1 = m0End IfNextDim vas1 As String * 5, vas2 As String * 5, vas3 As String * 5, vas4 As String * 20Dim vas5 As String * 10, vas6 As String * 20txt = txt & Chr(13) & Chr(10)txt = txt & "导线平差成果表" & Chr(13) & Chr(10)txt = txt & Chr(13) & Chr(10)txt = txt & "角度观测成果表" & Chr(13) & Chr(10)txt = txt & Chr(13) & Chr(10)txt = txt & "-------------------------------------------------------------------" & Chr(13) & Chr(10)txt = txt & "测站" & Space(1) & "后视" & Space(1) & "前视" & Space(1) & "方向观测值(°′″)" & Space(1) & "改正数(″)" & Space(1) & "方向平差值(°′″)" & Space(1) & Chr(13) & Chr(10)Dim f(), f1(), f2()ReDim f(1 To n2)f() = 角度平差值(v1(), b1())For i = 1 To n2ReDim f1(1 To 3), f2(1 To 3)f1() = 度分离(b1(4 * i))v1(i) = Format(v1(i), "0.00")f2() = 度分离(f(i))LSet vas1 = b1(4 * i - 3)LSet vas2 = b1(4 * i - 2)LSet vas3 = b1(4 * i - 1)LSet vas4 = f1(1) & Space(1) & f1(2) & Space(1) & f1(3)LSet vas5 = v1(i)LSet vas6 = f2(1) & Space(1) & f2(2) & Space(1) & f2(3)txt = txt & vas1 & vas2 & vas3 & vas4 & vas5 & vas6 & Chr(13) & Chr(10)Nexttxt = txt & "---------------------------------------------------------------------" & Chr(13) & Chr(10)txt = txt & Chr(13) & Chr(10)txt = txt & "边长观测成果表" & Chr(13) & Chr(10)txt = txt & Chr(13) & Chr(10)txt = txt & "---------------------------------------------------------------------" & Chr(13) & Chr(10) Dim bz()ReDim bz(1 To n3 + 3)bz() = 边长相对中误差(mm0, nni(), b3(), d1())Dim bc()ReDim bc(1 To n3)bc = 边长平差值(v2(), d1())txt = txt & "起点" & Space(1) & "终点" & Space(1) & "观测边长(m)" & Space(1) & "改正数(mm)" & "边长平差值(m)" & Space(1) & "边长观测值的相对中误差" & Chr(13) & Chr(10) Dim vas7 As String * 12, vas8 As String * 12For i = 1 To n3v2(i) = v2(i) * 1000: v2(i) = Format(v2(i), "0.0")LSet vas1 = d1(3 * i - 2)LSet vas2 = d1(3 * i - 1)LSet vas7 = d1(3 * i)LSet vas5 = v2(i)LSet vas8 = bc(i)LSet vas6 = "1:" & Space(1) & bz(i)txt = txt & vas1 & vas2 & vas7 & vas5 & vas8 & vas6 & Chr(13) & Chr(10)Nexttxt = txt & "--------------------------------------------------------------------" & Chr(13) & Chr(10)txt = txt & Chr(13) & Chr(10)txt = txt & "点位误差及误差椭圆" & Chr(13) & Chr(10)txt = txt & Chr(13) & Chr(10)txt = txt & "---------------------------------------------------------------------------------" & Chr(13) & Chr(10)txt = txt & "点号" & Space(1) & "误差X(mm)" & Space(1) & "误差Y(mm)" & Space(1) & "点位误差(mm)" & Space(1) & "椭圆长轴E(mm)" & Space(1) & "椭圆短轴(mm)" & Space(1) & "方位角(°′″)" & Chr(13) & Chr(10)Dim dw(), e()ReDim dw(1 To 3 * t), e(1 To 3 * t)dw() = 点位误差(mm0, t, nni())e() = 点位误差椭圆(mm0, t, nni())Dim vas9 As String * 10, vas10 As String * 10, vas11 As String * 12, vas12 As String * 12For i = 1 To tf1() = 度分离(e(3 * i))LSet vas1 = c(i)LSet vas9 = dw(3 * i - 2)LSet vas10 = dw(3 * i - 1)LSet vas7 = dw(3 * i)LSet vas8 = e(3 * i - 2)LSet vas11 = e(3 * i - 1)LSet vas12 = f1(1) & Space(1) & f1(2) & Space(1) & f1(3)txt = txt & vas1 & vas9 & vas10 & vas7 & vas8 & vas11 & vas12 & Chr(13) & Chr(10)Nexttxt = txt & "---------------------------------------------------------------------------------" & Chr(13) & Chr(10)txt = txt & Chr(13) & Chr(10)txt = txt & "坐标成果表" & Chr(13) & Chr(10)txt = txt & Chr(13) & Chr(10)txt = txt & "----------------------------------------------" & Chr(13) & Chr(10)txt = txt & "点号" & Space(2) & "坐标X(m)" & Space(12) & "坐标Y(m)" & Space(11) & Chr(13) & Chr(10)For i = 1 To n1LSet vas1 = a1(3 * i - 2)LSet vas4 = a1(3 * i - 1)LSet vas6 = a1(3 * i)txt = txt & vas1 & vas4 & vas6 & Chr(13) & Chr(10)NextFor i = 1 To tx0(2 * i - 1) = Format(x0(2 * i - 1), "0.0000"): x0(2 * i) = Format(x0(2 * i), "0.0000")LSet vas1 = c(i)LSet vas4 = x0(2 * i - 1)LSet vas6 = x0(2 * i)txt = txt & vas1 & vas4 & vas6 & Chr(13) & Chr(10)Nextm0 = Format(m0, "0.0")txt = txt & "---------------------------------------------" & Chr(13) & Chr(10)txt = txt & Chr(13) & Chr(10)txt = txt & "整网精度评定" & Chr(13) & Chr(10)txt = txt & Chr(13) & Chr(10)Dim vass As String * 20, vas17 As String * 20txt = txt & "----------------------------------------------" & Chr(13) & Chr(10) LSet vass = "导线全长:"LSet vas17 = bz(n3 + 3) & "Km"txt = txt & vass & vas17 & Chr(13) & Chr(10)LSet vass = "验前测角中误差:"LSet vas17 = mj & "″"txt = txt & vass & vas17 & Chr(13) & Chr(10)LSet vass = "验后测角中误差:"LSet vas17 = m1 & "″"txt = txt & vass & vas17 & Chr(13) & Chr(10)If Form8.Caption = "附合导线" ThenLSet vass = "实测角度闭合差:"LSet vas17 = bb & "″"txt = txt & vass & vas17 & Chr(13) & Chr(10)LSet vass = "允许角度闭合差:"LSet vas17 = bb1 & "″"txt = txt & vass & vas17 & Chr(13) & Chr(10)LSet vass = "坐标闭合差(cm):"LSet vas17 = "fx=" & fx & Space(1) & "fy=" & fytxt = txt & vass & vas17 & Chr(13) & Chr(10)LSet vass = "坐标增量相对差:"LSet vas17 = "1:" & fstxt = txt & vass & vas17 & Chr(13) & Chr(10)ElseIf Form8.Caption = "闭合导线" Thenbb = Format(bb, "0.0")LSet vass = "角度闭合差:"LSet vas17 = bb & "″"txt = txt & vass & vas17 & Chr(13) & Chr(10)LSet vass = "允许角度闭合差:"LSet vas17 = bb1 & "″"txt = txt & vass & vas17 & Chr(13) & Chr(10)LSet vass = "坐标闭合差(cm):"LSet vas17 = "fx=" & fx & Space(1) & "fy=" & fytxt = txt & vass & vas17 & Chr(13) & Chr(10)LSet vass = "坐标增量相对差:"LSet vas17 = "1:" & fstxt = txt & vass & vas17 & Chr(13) & Chr(10)End IfLSet vass = "单位权中误差:"LSet vas17 = m0 & "″"txt = txt & vass & vas17 & Chr(13) & Chr(10)LSet vass = "最弱边相对中误差" & "(" & d1(3 * bz(n3 + 1) - 2) & "-" & d1(3 * bz(n3 + 1) - 1) & ")" & ":"LSet vas17 = "1:" & bz(n3 + 2)txt = txt & vass & vas17 & Chr(13) & Chr(10)Form1.Text1.Alignment = 2Form1.Text1.Text = txterrorhandler:If Err.Number = 75 ThenExit SubEnd If100: End SubPrivate Sub list1_Click()If list1.Text = "不等精度" Then '等精度和不等精度的互换Label1.Caption = "单位权中误差(″)"Text2.BackColor = &H80000004Text2.Locked = TrueText3.BackColor = &H80000004Text3.Locked = TrueElseIf list1.Text = "等精度" ThenLabel1.Caption = "测角中误差(″)"Text2.BackColor = &H80000005Text2.Locked = FalseText3.BackColor = &H80000005Text3.Locked = FalseEnd IfEnd SubPrivate Sub Opt1_Click()If Opt1.Value ThenFrame3.Enabled = FalseLabel5.Enabled = FalseText4.BackColor = &H80000004Text4.Text = 1Text4.Locked = TrueOptd1.Enabled = FalseOptd2.Enabled = FalseEnd IfEnd SubPrivate Sub Opt2_Click()If Opt2.Value ThenFrame3.Enabled = TrueLabel5.Enabled = TrueText4.BackColor = &H80000005 Text4.Locked = FalseOptd1.Enabled = TrueOptd1.Value = TrueOptd2.Enabled = TrueEnd IfEnd SubPrivate Function 查错(a1(), n1, n2)End Function[em1][em1][em1]。

基于VB6.0的水准网抗差估计程序设计与开发

基于VB6.0的水准网抗差估计程序设计与开发
俞礼彬;岳东杰
【期刊名称】《测绘与空间地理信息》
【年(卷),期】2015(000)002
【摘要】针对当前水准网平差软件不能满足用户粗差探测需求的现状,基于VB6.0编写了水准网抗差估计程序,本程序可以在固定基准、秩亏基准、拟稳基准下对水准网平差,并利用7种不同的选权迭代法进行抗差估计,达到抗粗差干扰的目的.本文选用IGG-Ⅲ法在3种不同基准下进行抗差估计,结果验证了程序的正确性和可靠性.【总页数】3页(P196-197,201)
【作者】俞礼彬;岳东杰
【作者单位】河海大学地球科学与工程学院,江苏南京210098;河海大学地球科学与工程学院,江苏南京210098
【正文语种】中文
【中图分类】P224.1
【相关文献】
1.基于MATLAB的水准网平差程序设计与实现 [J], 陈永星;王蕾
2.水准网抗差估计程序设计 [J], 潘申运
3.基于VB6.0的水准网数据处理程序的实现 [J], 陈帅;王鹏
4.基于 MATLAB 的水准网平差程序设计 [J], 王鹏磊;刘长星
5.一种基于MATLAB的改进的水准网平差程序设计与实现 [J], 李亮亮;郭恒林;王利华
因版权原因，仅展示原文概要，查看原文内容请购买。

四等水准测量VB 程序代码

四等水准测量VB 程序Private Sub Command1_Click()Dim BBU As SingleDim BBM As SingleDim BBL As SingleDim BRM As SingleDim BK As SingleDim FBU As SingleDim FBM As SingleDim FBL As SingleDim FRM As SingleDim FK As SingleBBU = Val(ltrim$(rtrim$(Text1.Text) ))BBM = Val(ltrim$(rtrim$(Text2.Text) ))BBL = Val(ltrim$(rtrim$(Text3.Text) ))BRM = Val(ltrim$(rtrim$(Text4.Text) ))BK = Val(ltrim$(rtrim$(Text9.Text) ))FBU = Val(ltrim$(rtrim$(Text5.Text) ))FBM = Val(ltrim$(rtrim$(Text6.Text) ))FBL = Val(ltrim$(rtrim$(Text7.Text) ))FRM = Val(ltrim$(rtrim$(Text8.Text) ))FK = Val(ltrim$(rtrim$(Text10.Text) ))bdh = (BBM - FBM) '黑面高差'fdh = (BRM - FRM) '红面高差'If BK > FK Thenfdh = fdh - 0.1Elsefdh = fdh + 0.1End IfIf Abs((BBU - BBL) - (FBU - FBL)) * 100 > 3 Then MsgBox "前后视距较差超限"Exit Sub '退出程序'ElseIf Abs(BBM + BK - BRM) > 0.003 Then MsgBox "后视黑~红面读数较差超限"Exit Sub '退出程序'ElseIf Abs(FBM + FK - FRM) > 0.003 Then MsgBox "前视黑~红面读数较差超限"Exit Sub '退出程序'ElseIf Abs(bdh - fdh) > 0.005 ThenMsgBox "黑红面所测高差较差超限"Exit Sub '退出程序'Elsedh = Format((bdh + fdh) / 2, "0.0000") '计算高差'MsgBox "测站高差="& Str$(dh) &”m”,vbokonly,”计算结果” End IfDim hsjl As SingleDim qsjl As SingleDim qhsjc As SingleDim qhsjljc As SingleDim hchhmdsc As SingleDim qchhmdsc As SingleDim hmgc As SingleDim hmgc1 As SingleDim hhmgczc As Singlehsjl = (BBU - BBL) * 100qsjl = (FBU - FBL) * 100qhsjc = qsjl - hsjlhchhmdsc = BBU - BRMqchhmdsc = FBU - FRMhmgc = BBM - FBMhmgc1 = BRM - FRMhhmgczc = hmgc - hmgc1Text1.Text = Format(hsjl, "0.0000")Text2.Text = Format(qsjl, "0.0000")Text3.Text = Format(qhsjc, "0.0000")Text4.Text = Format(qhsjljc, "0.0000")Text5.Text = Format(hchhmdsc, "0.0000")Text6.Text = Format(qchhmdsc, "0.0000")Text7.Text = Format(hmgc, "0.0000")Text9.Text = Format(hhmgczc, "0.0000")Text8.Text = Format(hmgc1, "0.0000")End SubDim BBU As SingleDim BBM As SingleDim BBL As SingleDim BRM As SingleDim BK As SingleDim FBU As SingleDim FBM As SingleDim FBL As SingleDim FRM As SingleDim FK As SinglePrivate Sub Combo1_Click()Dim ReTxt As StringReTxt = Combo1.ListIndexBK = Combo1.List(ReTxt)End SubPrivate Sub Combo2_Click()Dim ReTxt As StringReTxt = Combo2.ListIndexFK = Combo2.List(ReTxt)End SubPrivate Sub Command1_Click()BBU = Val(LTrim$(RTrim$(Text1.Text))) BBM = Val(LTrim$(RTrim$(Text2.Text))) BBL = Val(LTrim$(RTrim$(Text3.Text))) BRM = Val(LTrim$(RTrim$(Text4.Text)))FBU = Val(LTrim$(RTrim$(Text5.Text))) FBM = Val(LTrim$(RTrim$(Text6.Text))) FBL = Val(LTrim$(RTrim$(Text7.Text))) FRM = Val(LTrim$(RTrim$(Text8.Text)))Dim BBU As SingleDim BBM As SingleDim BBL As SingleDim BRM As SingleDim BK As SingleDim FBU As SingleDim FBM As SingleDim FBL As SingleDim FRM As SingleDim FK As SinglePrivate Sub Combo1_Click()Dim ReTxt As StringReTxt = Combo1.ListIndexBK = Combo1.List(ReTxt)End SubPrivate Sub Combo2_Click()Dim ReTxt As StringReTxt = Combo2.ListIndexFK = Combo2.List(ReTxt)End SubPrivate Sub Command1_Click()BBU = Val(LTrim$(RTrim$(Text1.Text)))BBM = Val(LTrim$(RTrim$(Text2.Text)))BBL = Val(LTrim$(RTrim$(Text3.Text)))BRM = Val(LTrim$(RTrim$(Text4.Text)))FBU = Val(LTrim$(RTrim$(Text5.Text)))FBM = Val(LTrim$(RTrim$(Text6.Text)))FBL = Val(LTrim$(RTrim$(Text7.Text)))FRM = Val(LTrim$(RTrim$(Text8.Text)))bdh = (BBM - FBM) '黑面高差'fdh = (BRM - FRM) '红面高差'If BK > FK Thenfdh = fdh - 100Elsefdh = fdh + 100End IfIf Abs((BBU - BBL) - (FBU - FBL)) * 0.1 > 3 Then MsgBox "前后视距较差超限"Exit Sub '退出程序'ElseIf Abs(BBM + BK - BRM) > 3 Then MsgBox "后视黑~红面读数较差超限"Exit Sub '退出程序'ElseIf Abs(FBM + FK - FRM) > 3 Then MsgBox "前视黑~红面读数较差超限"Exit Sub '退出程序'ElseIf Abs(bdh - fdh) > 5 ThenMsgBox "黑红面所测高差较差超限"Exit Sub '退出程序'Elsedh = Format((bdh + fdh) / 2, "0.0000") '计算高差' Text10.Text = dh / 1000End IfEnd SubPrivate Sub Command2_Click()Text1.Text = ""Text2.Text = ""Text3.Text = ""Text4.Text = ""Text5.Text = ""Text6.Text = ""Text7.Text = ""Text8.Text = ""Text9.Text = ""Text10.Text = ""Text1.SetFocusEnd Sub。

平差程序核心代码(VB)

原文地址：平差程序核心代码（VB）作者：俞礼彬平差核心代码群：Const PI = 3.14159265358932'求AB的坐标方位角，输入是两点坐标，输出的是弧度值Public Function DirectAB(Xa#, Y a#, Xb#, Yb#) As Double Dim detX#, detY#, tana#detX = Xb - XadetY = Yb - Y aIf Abs(detX) < 0.000001 ThenIf detY > 0 ThenDirectAB = PI / 2ElseDirectAB = PI * 3 / 2End IfElsetana = detY / detXDirectAB = Atn(tana)If detX < 0 ThenDirectAB = PI + DirectABElseIf detX > 0 And detY < 0 ThenDirectAB = PI * 2 + DirectABEnd IfEnd IfEnd Function'弧度化为度.分秒的形式：输入弧度值，输出度.分秒（各占两位）Public Function HuToDo(ByV al Hu As Double) As Single Dim du%, fen%, miao%Hu = Hu * 180 / PIdu = Fix(Hu)Hu = (Hu - du) * 60fen = Fix(Hu)Hu = (Hu - fen) * 60miao = Fix(Hu + 0.5)If miao = 60 Thenfen = fen + 1miao = 0End IfIf fen = 60 Thendu = du + 1fen = 0End IfHuToDo = du + fen / 100 + miao / 10000End Function'将度.分秒形式化为弧度：输入为度.分秒形式，输出为弧度Public Function DoToHu(ByV al DoFenMiao As Double) As Single Dim du%, fen%, miao%, angle#du = Fix(DoFenMiao)DoFenMiao = (DoFenMiao - du) * 100fen = Fix(DoFenMiao)miao = (DoFenMiao - fen) * 100angle = du + fen / 60 + miao / 3600DoToHu = angle * PI / 180End Function'矩阵转置的通用过程Public Sub MatrixTrans(A, c)Dim i%, j%Dim R1%, C1%On Error Resume NextC1 = UBound(A, 2) - LBound(A, 2) + 1If Err ThenMsgBox "输入的矩阵维数不对！"Exit SubEnd IfR1 = UBound(A, 1) - LBound(A, 1) + 1ReDim c(1 To C1, 1 To R1)For i = 1 To R1For j = 1 To C1c(j, i) = A(i, j)Next jNext iEnd Sub'矩阵相加的通用过程Public Sub MatrixPlus(A, b, c)Dim i%, j%Dim R1%, C1%, R2%, C2%On Error Resume NextC1 = UBound(A, 2) - LBound(A, 2) + 1If Err ThenMsgBox "第一个矩阵维数不对！"Exit SubEnd IfOn Error Resume NextC2 = UBound(b, 2) - LBound(b, 2) + 1If Err ThenMsgBox "第二个矩阵维数不对！"Exit SubEnd IfR1 = UBound(A, 1) - LBound(A, 1) + 1R2 = UBound(b, 1) - LBound(b, 1) + 1If R1 <> R2 Or C1 <> C2 ThenMsgBox "输入的两个矩阵维数不等，不能相加！"Exit SubEnd IfReDim c(1 To m, 1 To n) As DoubleFor i = 1 To mFor j = 1 To nc(i, j) = A(i, j) + b(i, j)Next jNext iEnd Sub'矩阵相减的通用过程Public Sub MatrixMinus(A, b, c)Dim i%, j%Dim R1%, C1%, R2%, C2%On Error Resume NextC1 = UBound(A, 2) - LBound(A, 2) + 1If Err ThenMsgBox "第一个矩阵维数不对！"Exit SubEnd IfOn Error Resume NextC2 = UBound(b, 2) - LBound(b, 2) + 1If Err ThenMsgBox "第二个矩阵维数不对！"Exit SubEnd IfR1 = UBound(A, 1) - LBound(A, 1) + 1R2 = UBound(b, 1) - LBound(b, 1) + 1If R1 <> R2 Or C1 <> C2 ThenMsgBox "输入的两个矩阵维数不等，不能相减！"Exit SubEnd IfReDim c(1 To m, 1 To n) As DoubleFor i = 1 To mFor j = 1 To nc(i, j) = A(i, j) - b(i, j)Next jNext iEnd Sub'矩阵相乘：输入矩阵或数Qa、Qb，自动识别它们的维数，并输出它们的乘积QnPublic 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 BooleanOn Error Resume Next '看Qa是不是一维数组ic = UBound(Qa, 2) - LBound(Qa, 2)If Err Then e1 = TrueOn Error Resume Next '看Qa是不是一维数组ib = UBound(Qb, 2) - LBound(Qb, 2)If Err Then e2 = TrueIf 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 ciNext biNext aiElseIf e1 = True And e2 = False ThenOn Error Resume Nextia = UBound(Qa) - LBound(Qa)If Err Then e6 = TrueIf 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 biNext aiElse '一维矩阵乘以二维矩阵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 aiNext ciEnd IfElseIf e1 = False And e2 = True ThenOn Error Resume Nextic = UBound(Qb) - LBound(Qb)If Err Then e7 = TrueIf 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) * QbNext biNext aiElse '二维矩阵乘以一维矩阵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 biNext aiEnd IfElseDim errT As IntegerOn Error Resume Next '结果是否是一个数errT = UBound(Qn)If Err Then e3 = TrueIf 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 biNext aiExit SubEnd IfOn Error Resume Next '是否是数乘一维矩阵ia = UBound(Qa) - LBound(Qa)If Err Then e4 = TrueIf e4 ThenFor bi = LBound(Qa, 2) To UBound(Qa, 2)Qn(bi) = Qa * Qb(bi)Next biExit SubEnd IfOn Error Resume Next '是否是一维矩阵乘数ib = UBound(Qb) - LBound(Qb)If Err Then e5 = TrueIf e5 ThenFor ai = LBound(Qa, 1) To UBound(Qa, 1)Qn(ai) = Qa(ai) * QbNext aiExit SubEnd If'一维矩阵相乘结果是二维矩阵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 biNext aiEnd IfEnd Sub'矩阵相乘的通用过程Public Sub MatrixMulti(A, b, c)Dim i%, j%, K%Dim R1%, C1%, R2%, C2%On Error Resume NextC1 = UBound(A, 2) - LBound(A, 2) + 1If Err ThenMsgBox "第一个矩阵维数不对！"Exit SubEnd IfOn Error Resume NextC2 = UBound(b, 2) - LBound(b, 2) + 1If Err ThenMsgBox "第二个矩阵维数不对！"Exit SubEnd IfR1 = UBound(A, 1) - LBound(A, 1) + 1R2 = UBound(b, 1) - LBound(b, 1) + 1If C1 <> R2 ThenMsgBox "输入的两个矩阵大小不对，不能相乘！"Exit SubEnd Ifm = R1: s = C1: n = C2ReDim c(1 To m, 1 To n) As DoubleFor i = 1 To mFor j = 1 To nFor K = 1 To sc(i, j) = c(i, j) + A(i, K) * b(K, j)Next KNext jNext iEnd Sub'列选主元法Guass约化求解线性方程组Public Sub MajorInColGuass(A, b, X)Dim Row%, Col%, n% '矩阵大小Dim iStep%, iRow%, iCol% '循环变量Dim L() As Double '各行的约化系数'计算并检查矩阵的大小Row = UBound(A, 1) - LBound(A, 1) + 1Col = UBound(A, 2) - LBound(A, 2) + 1If Row <> Col ThenMsgBox "方程组的系数矩阵有误！"Exit SubEnd If'准备约化过程的变量和数组n = UBound(b) - LBound(b) + 1If n <> Row ThenMsgBox "方程组的系数矩阵与常数项大小不符！"Exit SubEnd IfReDim L(2 To Row) As DoubleDim sumAX As Double, iPos%, temp#'约化过程For iStep = 1 To n - 1'列选主元iPos = 0For iRow = iStep + 1 To nIf Abs(A(iRow, iStep)) > Abs(A(iStep, iStep)) TheniPos = iRowEnd IfNext iRowIf iPos > iStep Then '需要换主元For iCol = iStep To ntemp = A(iStep, iCol)A(iStep, iCol) = A(iPos, iCol)A(iPos, iCol) = tempNext iColtemp = b(iStep)b(iStep) = b(iPos)b(iPos) = tempEnd If'约化过程For iRow = iStep + 1 To nL(iRow) = A(iRow, iStep) / A(iStep, iStep)For iCol = iStep To nA(iRow, iCol) = A(iRow, iCol) - L(iRow) * A(iStep, iCol)Next iColb(iRow) = b(iRow) - L(iRow) * b(iStep)Next iRowShowMatrix ANext iStep'回代过程X(n) = b(n) / A(n, n)For iRow = n - 1 To 1 Step -1sumAX = 0For iCol = n To iRow + 1 Step -1sumAX = sumAX + A(iRow, iCol) * X(iCol)Next iColX(iRow) = (b(iRow) - sumAX) / A(iRow, iRow)Next iRowEnd Sub'Guass－Seidel迭代法求解线性方程组Private Function Seidel(A, b, X, eps#) As BooleanDim i%, j%Dim P#, Q#, s#, t#Dim Row%, Col%, n%Row = UBound(A, 1) - LBound(A, 1) + 1Col = UBound(A, 2) - LBound(A, 2) + 1n = UBound(b) - LBound(b) + 1If n <> Row ThenMsgBox "方程组的系数矩阵与常数项大小不符！"Exit FunctionEnd IfFor i = 1 To nP = 0#X(i) = 0#For j = 1 To nIf i <> j Then P = P + Abs(A(i, j))Next jIf P >= Abs(A(i, i)) ThenSeidel = FalseExit FunctionEnd IfNext iP = eps + 1#While P >= epsP = 0#For i = 1 To nt = X(i)s = 0#For j = 1 To nIf j <> i Then s = s + A(i, j) * X(j)Next jX(i) = (b(i) - s) / (A(i, i))Q = Abs(X(i) - t) '/ (1# + Abs(x(i)))If Q > P Then P = QNext iWendSeidel = TrueEnd FunctionPublic Sub ShowMatrix(tt)Dim i%, j%, n%, m%m = UBound(tt, 1) - LBound(tt, 1) + 1n = UBound(tt, 2) - LBound(tt, 2) + 1For i = 1 To mFor j = 1 To nDebug.Print tt(i, j),Next jDebug.PrintNext iEnd 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 Nexta1 = UBound(A, 1) - LBound(A, 1) + 1If Err ThenMsgBox "系数矩阵A大小错误！"Exit SubEnd IfOn Error Resume Nexta2 = UBound(A, 2) - LBound(A, 2) + 1If Err ThenMsgBox "系数矩阵A大小错误！"Exit SubEnd IfOn Error Resume NextL1 = UBound(L) - LBound(L) + 1If Err ThenMsgBox "常数向量L大小错误！"Exit SubEnd IfOn Error Resume Nextx1 = UBound(X) - LBound(X) + 1If Err ThenMsgBox "解向量X大小错误！"Exit SubEnd IfOn Error Resume Nextp1 = UBound(P, 1) - LBound(P, 1) + 1If Err ThenMsgBox "权矩阵P大小错误！"Exit SubEnd IfOn Error Resume Nextp2 = UBound(P, 2) - LBound(P, 2) + 1If Err ThenMsgBox "权矩阵P大小错误！"Exit SubEnd IfIf p1 <> p2 ThenMsgBox "权矩阵P不是方阵！"Exit SubEnd IfIf p1 <> a1 Or p2 <> a1 ThenMsgBox "权矩阵P与系数矩阵A大小不符！"Exit SubEnd IfIf a2 <> x1 ThenMsgBox "系数矩阵A大小与解向量X大小不符！" Exit SubEnd IfIf a1 <> L1 ThenMsgBox "系数矩阵A大小与常数向量L大小不符！" Exit SubEnd 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 AMatrixTrans A, At '求A的转置矩阵Debug.Print "The At matrix is:"ShowMatrix AtDebug.Print "The P matrix is:"ShowMatrix PMatrix_Multy AtP, At, P '求AtPDebug.Print "and The AtP matrix is:"ShowMatrix AtPMatrix_Multy Naa, AtP, A'法方程系数矩阵Debug.Print "the Naa matrix is:"ShowMatrix NaaDebug.Print "the L matrix is:"For x1 = LBound(L) To UBound(L)Debug.Print L(x1)Next x1Matrix_Multy W, AtP, L '法方程常数向量Debug.Print "the W matrix is:"For x1 = LBound(W) To UBound(W)Debug.Print W(x1)Next x1MajorInColGuass Naa, W, XDebug.Print "the X matrix is:"For x1 = LBound(X) To UBound(X)Debug.Print X(x1)Next x1'Seidel Naa, W, x, 0.000001End 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 Nextb1 = UBound(b, 1) - LBound(b, 1) + 1If Err ThenMsgBox "系数矩阵B大小错误！"Exit SubEnd IfOn Error Resume Nextb2 = UBound(b, 2) - LBound(b, 2) + 1If Err ThenMsgBox "系数矩阵B大小错误！"Exit SubEnd IfOn Error Resume Nextw1 = UBound(W) - LBound(W) + 1If Err ThenMsgBox "常数向量W大小错误！"Exit SubEnd IfOn Error Resume Nextv1 = UBound(V) - LBound(V) + 1If Err ThenMsgBox "改正数向量V大小错误！"Exit SubEnd IfOn Error Resume Nextp1 = UBound(P, 1) - LBound(P, 1) + 1If Err ThenMsgBox "权矩阵P大小错误！"Exit SubEnd IfOn Error Resume Nextp2 = UBound(P, 2) - LBound(P, 2) + 1If Err ThenMsgBox "权矩阵P大小错误！"Exit SubEnd IfIf p1 <> p2 ThenMsgBox "权矩阵P不是方阵！"Exit SubEnd IfIf p1 <> b2 ThenMsgBox "权矩阵P与系数矩阵A大小不符！"Exit SubEnd IfIf b2 <> v1 ThenMsgBox "系数矩阵B大小与解向量V大小不符！"Exit SubEnd IfIf b1 <> w1 ThenMsgBox "系数矩阵B大小与常数向量W大小不符！"Exit SubEnd 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)Next iMatrixTrans b, BtMatrix_Multy QBt, Q, BtMatrix_Multy Nbb, b, QBt '法方程系数矩阵ShowMatrix NbbMajorInColGuass Nbb, W, K '解法方程'Seidel Nbb, W, K, 0.0000001Matrix_Multy V, QBt, K '求改正数End Sub。

VB开发水准测量平差软件的方法

VB开发水准测量平差软件的方法摘要：本文介绍了应用Visual Basic6.0开发的水准测量平差软件的方法。

通过软件自动生成EXCEL格式的水准测量平差计算表格进行数据处理，快速、准确计算出待求点的高程。

关键词：VB；数据处理;水准测量水准测量平差计算就是对合格的高差予以调整。

将闭合差以相反的符号按与各段水准路线长度（或按测站数）成正比的办法调整到各段高差上，求出改正后的高差再推算高程。

手工计算速度慢、工作效率低，同时易出现计算错误，而Visual Basic6.0是一种简单易学的可视化语言，用其进行编程计算就显得方便灵活。

本文结合作者工作的实践，详细地介绍了用VB开发水准测量平差软件的方法及应用。

1.VB语言的特点(1).面向对象和可视化的程序设计。

(2).事件驱动的运行机制。

(3).结构化的程序设计语言。

(4).多种数据库访问能力。

(5).提供了功能完备的应用程序集成开发环境。

(6).方便使用的联机帮助功能。

2.水准测量平差计算的方法(1).计算高差闭合差fh。

fh=Σh测 -（H终-H始）fh允=±20(按四等水准测量限差)fh≤fh允(合格)fh允—允许闭合差；Σh测—实测的各段高差和；H始—起点高程；H终—终点高程；(2).计算高差改正数Vi。

Σn —总测站数或路线总长度(km)；ni —分段测站数或分段路线长度(km)；(3).计算改正后高差h改i。

h改i=h测¬ + Vi(4).计算待求点高程Hi。

Hi=Hi-1+ h改i3．软件的开发原理首先在VB中设计了一个固定的界面（图3.1），添加相应功能键及数据输入文本框，通过输入相应的数据，利用VB编程实现自动生成电子表格；通过VB操作电子表格里数据进行平差计算。

根据不同的平差方法，本软件设置按距离进行平差和按测站数进行平差两种计算方法。

图3.1水准测量平差软件界面3.1参数输入方式数据输入设计成两种方式；一种是先建立文本格式(txt)的参数文件，通过编写程序代码实现直接读取数据。

四等水准附和导线、闭合导线平差VB代码

程序说明:数据录入文件的存储格式为:按每一测站的距离、高差形式存储,平差之前需要输入测站总数,依次点击“平差计算”、“成果分析”、“成果输出“。

Dim ds() As Single, ht() As Single, detht() As Single, zh() As Single 'ht测量高差,deth高差改正数,zh点高程Dim fht As Single, n As Integer, fr As Single, sds As Single 'fht 高差闭合差,n测站数,fr高差闭差合限差,sds线路总长Private Sub Command3_Click()EndEnd SubPrivate Sub Command5_Click()Dim i As Integern = Val(Text3.Text)If n = 0 ThenMsgBox "请输入测站数"Exit SubEnd IfReDim ht(n) As Single, ds(n) As Single, detht(n) As Single, zh(n) As SingleCD.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"CD.ShowOpenstrfilename = CD.FileNameOpen strfilename For Input As #1For i = 1 To nInput #1, ds(i), ht(i)If ds(i) > 160 ThenMsgBox "第" & i & "测站视距超限"Exit SubEnd IfNext iClose #1MsgBox "数据已录入"End SubPrivate Sub Command6_Click()Dim i As Integer, sht As Single, x As Single Dim a As Single, b As Singlesds = 0sht = 0For i = 1 To nsds = sds + ds(i)sht = sht + ht(i) Next iIf Option1.Value Thena = Val(Text1.Text)b = Val(Text2.Text) fht = sht - (a - b) ElseIf Option2.Value Then a = Val(Text1.Text) fht = shtEnd IfEnd Ifzh(0) = aFor i = 1 To nx = -fht * ds(i) / sdsdetht(i) = xht(i) = ht(i) + detht(i)zh(i) = zh(i - 1) + ht(i)Next iMsgBox "平差计算已完成"End SubPrivate Sub Command7_Click()Dim x As Singlefr = 40 * Sqr(sds / 1000)x = Abs(fht)If x > fr ThenMsgBox "线路全长高差闭合差超限,但系统已按照平差原理平差,如需保存结果,请点击“成果保存”按钮"Exit SubElseMsgBox "线路全长高差闭合差符合限差要求,如需保存结果,请点击“成果保存”按钮"End IfEnd SubPrivate Sub Command8_Click()Dim i As IntegerCD.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"CD.ShowOpenstrfilename = CD.FileNameOpen strfilename For Output As #2For i = 1 To nPrint #2, "第" & i & "测站视线长:" & ds(i) & "m",Print #2, "高差改正数:" & Format(detht(i), "0.000") & "m",Print #2, "改后高差:" & Format(ht(i), "0.000") & "m",Print #2, "高程:" & Format(zh(i), "0.000") & "m"Next iPrint #2, "路线全长:" & Format(sds / 1000, "0.000") & "km"Print #2, "路线全长高差闭合差:" & Format(fht, "0.000") & "m" Print #2, "限差:" & Format(fr / 1000, "0.000") & "m"Print #2, "解算人:×××"Print #2, "时间:" & DateClose #2MsgBox "成果已保存"End Sub。

基于MatrixVB的水准网平差程序设计

基于MatrixVB的水准网平差程序设计摘要：本文首先介绍了MatrixVB的一些基本功能和应用，然后简要阐述了水准网平差程序的设计方法和步骤，最后利用VB6.0和MatrixVB实现水准网平差程序的设计。

关键词：VB6.0；MatrixVB；测量平差程序设计；水准网平差1引言目前，在测量平差程序设计中经常要利用矩阵计算，程序设计者往往将矩阵的计算编制成基于数组的函数模块，在需要时直接调用之，这些模块的设计、调试工作量大不说，在调用前还需要重新定义各数组的大小，使用起来比较麻烦；这里介绍了一个基于MATLAB的的组件MatrixVB，它具有强大的矩阵计算、图形图像处理、最优化运算等功能，结合VB6.0进行测量程序的设计，程序步骤清晰，计算结果可靠，可以节约大量的程序设计时间，是一种很好的测量程序设计方法。

2MatrixVB介绍MatrixVB是由Mathtools公司提供的一个COM组件，它提供了很多有效的类似MATLAB算法，特别是其矩阵计算功能，在测量平差程序设计中可以发挥巨大的作用。

2.1MatrixVB的安装在安装盘上找到MatrixVB安装文件，双击后按照安装向导安装，安装完毕后注册动态链接库mMatrix.dll，其方法为是在电脑的“开始—运行”菜单中输入命令“regsvr32mMatrix.dll”即可。

2.2VB开发程序的前期准备打开VB6.0，建立VB程序，然后一定要在“Project—References”下选上“MMatrix”，见下图这样配置后在开发过程中就可以使用矩阵的一些运算符了，如矩阵求逆B=inv（A）等；2.3VB6.0中数组在MatrixVB中的应用在vb6.0中定义的数组可以通过mabs（）、CreateMatrix（）等转化为MatrixVB中的矩阵，当然在MatrixVB环境下，可以默认将VB6.0中的数组转化为MatrixVB矩阵，即能直接把数组当作矩阵来使用。

基于VB的水准网结点平差及精度评定

＠
２１ＳｉＴｃ．ｎｒ．０２ｃｅｈＥｇ．ｇ
建筑技术
基于ＶＢ的水准网结点平差及精度评定
吕翠华陈秀萍李明
（昆明冶金高等专科学校测绘学院，云南省测绘产品检测站，昆明６０３）５０３
摘要关键词
主要讨论利用结点法进行水准网平差的问题。通过对平差模型的分析，出利用迭代法进行结点式平差计算，出提导结点平差水准网精度评定文献标志码高程Ａ
３１５２
科
学
技
术
与
工
程
பைடு நூலகம்１２卷
Ｐ（＋ｈ）＋Ｐ（Ｂ＋ｈ）＋Ｐ（１月１２Ｈ２５２一ｈ）５
ａ１一，Ｐ＋Ｐ
，
＋Ｐ
彘（＋３ｍｍｏ２）
由＝ｍ得到：２：ｍｏｍｏ＝ｍ２
。
．
（）１Ｐ（ｃ＋ｈ）＋Ｐ（ｌ３Ｈ３４月Ｄ＋ｈ）＋Ｐ（４５１＋ｈ）５
２１０２年２月２９日收到
如图１所示，Ｅ、的高程平差值为、，设Ｆ点则列出结点表达式（）式（）１、２。
第一作者简介：吕翠华（９６）女，１７一，云南宣威人，教授，副工学硕
士，研究方向：测绘与地理信息系统应用。
式中，为与待定点ｉ连的各条水准路线另一端相点的协因数，当该端点是已知点时，协因数值为其零；＾为与待定点ｉＱ，相连的各条水准路线观测高差的权倒数。若以水准路线长定权，则＝１，

平面和高程控制测量VB程序设计报告

题目：习题7.1平面和高程控制网平差蒲浡轩测绘C101班106684余数7一、设计思路题目为：平面控制网和高程控制网的平差1、流程图2、界面设计上面为开始主程序，在该页面进行高程控制网平差，点击平面控制启动下面的程序页面进行平面控制网平差。

2、功能设计通过菜单实现程序的各个功能，通过菜单启动Common Dialog Control控件输入txt文档，读取txt里面的高程或平面控制网数据，然后点击各个计算菜单进行平差计算二、算法及代码实现1、Form1代码：Dim strFileName As StringDim nn%, un%, tn%, hn% '已知点个数，未知点个数，总点数，观测值个数Dim Pname() As String '点名数组Dim Hknown() As Double '已知高程数组，存放已知点高程和高程近似值Dim bE%(), en%() '观测值的起点和终点编号数组，存储的是点序号Dim h#(), s#() '高差观测值数组和距离观测值数组Dim a#(), x#(), P#(), L#() '间接平差的系数阵、解向量、权阵和常数向量'高程平差计算Private Sub mnuAdj_Click()Dim i%, j%ReDim x(1 To un)InAdjust a, P, L, x '调用间接平差的通用过程求解'计算并显示高程平差结果txtShow.Text = txtShow.Text & "平差计算结果：" & vbCrLftxtShow.Text = txtShow.Text & "点号初始高程(m) 高程改正数(m) 平差后高程(m)" & vbCrLfFor i = 1 To untxtShow.Text = txtShow.Text & Pname(nn + i) & " " & Format(Hknown(nn + i), "0.0000")Hknown(nn + i) = Hknown(nn + i) + x(i)txtShow.Text = txtShow.Text & " " & Format(x(i), "0.0000") & " " & Format(Hknown(nn + i), "0.0000") & vbCrLfNext itxtShow.Text = txtShow.Text & vbCrLf'计算并显示单位权中误差--------->>精度评定部分应该也包含在间接平差模块里，一起来调用' Dim dblT As Double' dblT = 0' For i = 1 To un'' Next iEnd SubPrivate Sub mnuCalc_Click(Index As Integer)Form1.Visible = FalsefrmMain.Visible = TrueEnd Sub'误差方程Private Sub mnuEqu_Click()Dim i%, j%ReDim a(1 To hn, 1 To un), L(1 To hn), P(1 To hn, 1 To hn)'对每个观测值列误差方程For i = 1 To hnIf en(i) > nn Then a(i, en(i) - nn) = 1 '若终点未知，则给终点对应的系数矩阵元素赋值If bE(i) > nn Then a(i, bE(i) - nn) = -1 '若起点未知，则给起点对应的系数矩阵元素赋值L(i) = -(Hknown(en(i)) - Hknown(bE(i)) - h(i)) '根据起终点计算常数项P(i, i) = 1 / s(i) '以距离的倒数为权 Next i'显示误差方程txtShow.Text = txtShow.Text & " 列立的误差方程：" & vbCrLfFor i = 1 To hnFor j = 1 To untxtShow.Text = txtShow.Text & a(i, j) & " "Next jtxtShow.Text = txtShow.Text & " " & Format(L(i), "0.0000") & vbCrLfNext itxtShow.Text = txtShow.Text & "权矩阵：" & vbCrLfFor i = 1 To hnFor j = 1 To hntxtShow.Text = txtShow.Text & P(i, j) & " "Next jtxtShow.Text = txtShow.Text & vbCrLfNext iEnd SubPrivate Sub mnuHeight_Click()'计算近似高程Dim i%, j%For i = 1 To unFor j = 1 To hnIf bE(j) = nn + i And en(j) < nn + i Then '找到一个起点相同且终点已知的观测值Hknown(nn + i) = Hknown(en(j)) - h(j)Exit ForEnd IfIf en(j) = nn + i And bE(j) < nn + i Then '找到一个终点相同且起点已知的观测值Hknown(nn + i) = Hknown(bE(j)) + h(j)Exit ForEnd IfNext jNext i'显示近似高程计算结果txtShow.Text = txtShow.Text & " 近似高程计算结果： " & vbCrLf For i = 1 To untxtShow.Text = txtShow.Text & Pname(i + nn) & "：" & Format(Hknown(i + nn), "0.000") & vbCrLfNext iEnd Sub'打开高程文件Private Sub mnuHOpen_Click()Dim i As Integer '循环变量Dim strT1 As String, strT2 As StringCDg1.Filter = "文本文件（*.txt）|*.txt|所有文件（*.*）|*.*"CDg1.ShowOpen '打开对话框strFileName = CDg1.FileName '获得选中的文件名和路径Open strFileName For Input As #1 '打开文件Input #1, nn, un, hn '读入已知点个数，未知点个数，观测值个数tn = nn + unReDim Pname(1 To tn), Hknown(1 To tn)ReDim h(1 To hn), s(1 To hn), bE(1 To hn), en(1 To hn)For i = 1 To tn '读入点名Input #1, Pname(i)Next iFor i = 1 To nn '读入已知高程Input #1, Hknown(i)Next iFor i = 1 To hn '读入各观测值Input #1, strT1, strT2, h(i), s(i)bE(i) = Order(strT1): en(i) = Order(strT2) '给起终点数组排序Next i'显示读入的数据txtShow.Text = txtShow.Text & "读入的水准网数据：" & vbCrLf txtShow.Text = txtShow.Text & " 已知点" & nn & "个，未知点" & un & "个，观测值" & hn & "个。

基于 VB 的水准网经典平差系统的开发与应用

基于 VB 的水准网经典平差系统的开发与应用张广宇;欧阳兆灼;那福超;杨帆【摘要】根据水准网数据特征，按已知数据、观测数据以及水准网边和点的相对位置关系设计了数据组织结构。

基于间接平差模型，在VB环境下设计开发了水准网平差系统。

选取了一组水准网数据，计算了水准网的高程平差值、高程中误差、高差平差值和高差中误差，并与已有计算结果作了对比，验证了程序编制的正确性和系统运行的可靠性。

%On the basis of the data structuredesigned ,according to the known data ,observation data and the relation of points and lines by the characteristics of the leveling net .Using VB to code ,designes and developes an adjustment system of levelling net ,based on indirect adjustment model .Choosing a set of levelling net data to calculate adjusted value and mean square error of elevation and elevation difference ,and makes a comparison with existing results ,and verification the validity of the programming and the reliability of the system .【期刊名称】《中国矿业》【年(卷),期】2014(000)0z2【总页数】4页(P354-357)【关键词】水准网;间接平差;中误差;VB;高差【作者】张广宇;欧阳兆灼;那福超;杨帆【作者单位】中国地质大学北京地球科学与资源学院，北京100083; 中国地质调查局沈阳地质调查中心，辽宁沈阳110034;中国地质调查局沈阳地质调查中心，辽宁沈阳110034;中国地质调查局沈阳地质调查中心，辽宁沈阳110034;中国地质调查局沈阳地质调查中心，辽宁沈阳110034【正文语种】中文【中图分类】P207水准测量是建立高程控制的一种常规方法，也是高精度沉降监测的主要手段之一。

水准网平差、矩阵运算MFC代码

误差理论与测量平差上机指导书钱建国张恒憬编写辽宁工程技术大学测绘与地理科学学院测绘工程系目录Visual C++平差编程实现 (2)1矩阵加法 (2)2矩阵乘法 (2)3 矩阵转置 (4)4 矩阵求逆 (4)5 水准网间接平差实例（分组选做） (11)Matlab平差编程实现（分组选做） (19)1 间接平差 (19)Visual C++平差编程实现一、实验名称：解算法方程。

二、实验目的和任务：掌握矩阵加法、乘法与求逆的通用程序的编写。

三、实验要求：1每人独立编写出矩阵加法与乘法的程序，并上机调试通过；2采用VC++6.0开发平台，C或者C++语言编写程序；3写出矩阵运算的结果。

四、实验内容：1矩阵加法矩阵加法的示例函数(C语言)void JZjiafa(double a[15][15],double b[15][15],double c[15][15],intm,int n){for (int i=0;i<=m-1;i++)for(int j=0;j<=n-1;j++){c[i][j]=a[i][j]+b[i][j];}return;}2矩阵乘法矩阵乘法的示例程序(C语言)#include "stdafx.h"void matrixMultiply(double a[14][15],double b[15][13], doublec[14][13],long m,long n,long k){for (long i = 0; i<= m-1; i++){for (long j=0; j<=k-1; j++){c[i][j] =0.0;for (long q=0; q<=n-1;q++){c[i][j] = c[i][j] + a[i][q] * b[q][j];}}}return;}int main(int argc, char* argv[]){long n,m,k,i,j;double a[14][15],c[14][13],b[15][13];FILE *stream;stream = fopen("矩阵输入.txt","r");fscanf(stream,"%ld %ld",&n,&m);for (i=0;i<n;i++){for(j=0;j<m;j++){fscanf(stream,"%lf",&a[i][j]);}}fscanf(stream,"%ld %ld",&m,&k);for(i=0;i<m;i++){for(j=0;j<k;j++){fscanf(stream,"%lf",&b[i][j]);}}fclose(stream);matrixMultiply(a,b,c,4,5,3);stream = fopen("矩阵计算结果.txt","w");for (i=0;i<=3;i++){for(j=0;j<=2;j++)fprintf(stream,"%16.7e ",c[i][j]);fprintf(stream,"\n");}fprintf(stream,"\n");fclose(stream);return 0;}3 矩阵转置矩阵的转置示例函数(C语言)double JZzhuanzhi(double a[15][15], double b[15][15], int m,int n) {{for(int i=0;i<m;i++)for(int j=0;j<n;j++)b[j][i]=a[i][j];}return 0.0;}4 矩阵求逆矩阵求逆的示例函数(C语言)int invGJ(double **a,int n){int *is,*js,i,j,k,l,u,v;double d,p;is=(int *)malloc(n*sizeof(int));js=(int *)malloc(n*sizeof(int));for(k=0;k<=n-1;k++){d=0.0;for(i=k;i<=n-1;i++)for(j=k;j<=n-1;j++){l=i*n+j;p=fabs(a[i][j]);if(p>d){d=p;is[k]=i;js[k]=j;}}if(d+1.0==1.0){free(is);free(js);printf("error not inv\n");return (0);}if(is[k]!=k)for(j=0;j<=n-1;j++){u=k*n+j;v=is[k]*n+j;p=a[k][j];a[k][j]=a[is[k]][j];a[is[k]][j]=p;}if(js[k]!=k)for(i=0;i<=n-1;i++){u=i*n+k;v=i*n+js[k];p=a[i][k];a[i][k]=a[i][js[k]];a[i][js[k]]=p;}l=k*n+k;a[k][k]=1.0/a[k][k];for(j=0;j<=n-1;j++)if(j!=k){u=k*n+j;a[k][j]=a[k][j]*a[k][k];}for(i=0;i<=n-1;i++)if(i!=k)for(j=0;j<=n-1;j++)if(j!=k){u=i*n+j;a[i][j]=a[i][j]-a[i][k]*a[k][j];}for(i=0;i<=n-1;i++)if(i!=k){u=i*n+k;a[i][k]=-a[i][k]*a[k][k];}}for(k=n-1;k>=0;k--){if(js[k]!=k)for(j=0;j<=n-1;j++){u=k*n+j;v=js[k]*n+j;p=a[k][j];a[k][j]=a[js[k]][j];a[js[k]][j]=p;}if(is[k]!=k)for(i=0;i<=n-1;i++){u=i*n+k;v=i*n+is[k];p=a[i][k];a[i][k]=a[i][is[k]];a[i][is[k]]=p;}}free(is);free(js);return (1);} int invGJ(double **a,int n){int *is,*js,i,j,k,l,u,v;double d,p;is=(int *)malloc(n*sizeof(int));js=(int *)malloc(n*sizeof(int));for(k=0;k<=n-1;k++){d=0.0;for(i=k;i<=n-1;i++)for(j=k;j<=n-1;j++){l=i*n+j;p=fabs(a[i][j]);if(p>d){d=p;is[k]=i;js[k]=j;}}if(d+1.0==1.0){free(is);free(js);printf("error not inv\n");return (0);}if(is[k]!=k)for(j=0;j<=n-1;j++){u=k*n+j;v=is[k]*n+j;p=a[k][j];a[k][j]=a[is[k]][j];a[is[k]][j]=p;}if(js[k]!=k)for(i=0;i<=n-1;i++){u=i*n+k;v=i*n+js[k];p=a[i][k];a[i][k]=a[i][js[k]];a[i][js[k]]=p;}l=k*n+k;a[k][k]=1.0/a[k][k];for(j=0;j<=n-1;j++)if(j!=k){u=k*n+j;a[k][j]=a[k][j]*a[k][k];}for(i=0;i<=n-1;i++)if(i!=k)for(j=0;j<=n-1;j++)if(j!=k){u=i*n+j;a[i][j]=a[i][j]-a[i][k]*a[k][j];}for(i=0;i<=n-1;i++)if(i!=k){u=i*n+k;a[i][k]=-a[i][k]*a[k][k];}}for(k=n-1;k>=0;k--){if(js[k]!=k)for(j=0;j<=n-1;j++){u=k*n+j;v=js[k]*n+j;p=a[k][j];a[k][j]=a[js[k]][j];a[js[k]][j]=p;}if(is[k]!=k)for(i=0;i<=n-1;i++){u=i*n+k;v=i*n+is[k];p=a[i][k];a[i][k]=a[i][is[k]];a[i][is[k]]=p;}}free(is);free(js);return (1);}矩阵求逆函数的调用(C语言)#include <stdio.h>#include <stdlib.h>#include <math.h>int invGJ(double **a,int n);void main(){int i,j;double **AA;//首先对二维指针Naa分配内存，采用C语言的方法/* AA=(double **)malloc(sizeof(double)*2);for(i=0;i<2;i++){AA[i]=(double *)mallo(sizeof(double)*2);}*///首先对二维指针Naa分配内存，采用C++语言的方法AA=new double * [2];for(i=0;i<2;i++){AA[i]=new double[2];}double BB[2][2]={1,2,3,4};for(i=0;i<2;i++){for(j=0;j<2;j++){AA[i][j]=BB[i][j];}}//调用矩阵求逆函数invGJ(AA,2);printf("矩阵AA的逆阵如下\n");for(i=0;i<2;i++){for(j=0;j<2;j++){printf("%10.4lf",AA[i][j]);}printf("\n");}double CC[2][2];printf("AA与其逆阵的乘积如下(理论上是单位阵)\n"); for(i=0;i<2;i++){for(j=0;j<2;j++){CC[i][j]=0.0;for(int k=0;k<2;k++){CC[i][j]+=AA[i][k]*BB[k][j];}printf("%10.4lf",CC[i][j]);}printf("\n");}//C 语言释放AA 二维指针的方法 /* for(i=0;i<2;i++){free(AA[i]);}free(AA);*/ //C++语言释放AA 二维指针的方法 for(i=0;i<2;i++) { delete AA[i]; } delete AA;}5 水准网间接平差实例（分组选做）例1：在图1所示的水准网中，已知水准点A 的高程为H A =237.483，为求B 、C 、D 三点的高程，进行了水准测量，测得高差5×1L和水准路线的长度5×1S ，其结果见表1，试按间接平差求定B 、C 、D 三点的高程平差值。

GPS基线向量网平差VB程序设计

GPS基线向量网平差程序设计前言GPS技术以其定位精度高，观测自动化,不需测站间通视及网型与精度关系不大的优势,已成为建立城市及工程控制网的主要技术手段之一。

而与常规地面网相比,GPS控制网的数据处理有其自身的特点，由于基线向量是不可独立于坐标系而存在的特殊观测值，所以在平差时或平差后必须转入测区所在的坐标系统。

本论文讨论了GPS基线向量的转换和平差问题及工程控制测量实用的方法，并运用VB程序设计语言完成了大地空间直角坐标向大地坐标的转换、大地坐标向高斯平面坐标的转换、二维基线向量网平差的功能。

1GPS原理1.1 GPS的简介全球定位系统（全局位置系统，GPS）是美国从上世纪70年代开始研制，历时20年，耗资200亿美元，于1994年全面建成的利用导航卫星进行测时和测距，具有在海、陆、空进行全方位实时三维导航与定位能力的新一代卫星导航与定位系统。

它是继阿波罗登月计划、航天飞机后的美国第三大航天工程。

如今，GPS已经成为当今世界上最实用，也是应用最广泛的全球精密导航、指挥和调度系统。

它主要由三大子系统构成：空间卫星系统、地面监控系统、用户接收系统。

1.2 GPS定位原理GPS系统采用高轨测距体制，以观测站至GPS卫星之间的距离作为基本观测量。

为了获得距离观测量，主要采用两种方法：一是测量GPS卫星发射的测距码信号到达用户接收机的传播时间，即伪距测量；一是测量具有载波多普勒频移的GPS卫星载波信号与接收机产生的参考载波信号之间的相位差，即载波相位测量。

采用伪距观测量定位速度最快，而采用载波相位观测量定位精度最高。

通过对４颗或４颗以上的卫星同时进行伪距或相位的测量即可推算出接收机的三维位置。

按定位方式，GPS 定位分为单点定位和相对定位（差分定位）。

单点定位就是根据一台接收机的观测数据来确定接收机位置的方式，它只能采用伪距观测量。

相对定位（差分定位）是根据两台以上接收机的观测数据来确定观测点之间的相对位置的方法，它既可采用伪距观测量也可采用相位观测量。

基于VB环境下水准网平差程序设计研究

水准网间接平差设计流程大致分为５个步骤，
则如果有托个观测值，总的误差方程为：则
Ｔｒ
一
＾
Ｔｒ
一
Ｔ
／ｒ、
分别是已知观测数据输人、测数据信息提取、观未知点近似高程计算、差方程系数矩阵Ａ和Ｌ生误
成、求解未知参数值。
“
式中
下水准网平差程序设计研究
未知点平差后的高程最或然值。
１３
２１已知数据输入和观测数据信息提取．已知数据按照一定的格式编辑在文本文档中，按行读取到程序中，据输入后，序首先对已知数程
其中为每段高差的水平距离
。
因此只要确定
出矩阵Ａ和矩阵Ｌ就可求出高程改正值，而求出进
如果，点都为未知点，两则误差方程为：
未知点高程的最或然值。
＋一一＋￡
，
（）２水准网间接平差程序设计思路４
高差组成的误差方程的系数组成矩阵Ａ。矩阵Ｌ
２
Ａ
Ｃ
３５．２
１．４２
中的元素则为相应的终点近似高程或减去起点的相应近似高程或已知高程以及观测高差的值。
２４求解未知点高程改正值．
３
４
５
Ａ
Ｂ
Ｂ

基于VB6.0的水准网数据处理程序的实现

基于VB6.0的水准网数据处理程序的实现陈帅;王鹏【摘要】基于VB6.0语言环境设计了水准网综合数据处理的程序,实现了基于平差基准的最小二乘估计和抗差估计,自动搜索闭合条件、计算闭合差,弥补了现有矿区水准网平差程序或软件中存在的不足,针对程序实现中的关键性问题进行了比较详细的分析并给出了部分程序实现的代码,并通过实测数据进行了验证.【期刊名称】《全球定位系统》【年(卷),期】2014(039)004【总页数】5页(P73-77)【关键词】最小二乘估计;闭合差;抗差估计【作者】陈帅;王鹏【作者单位】天津市普迅电力信息技术有限公司,天津300000;天津市普迅电力信息技术有限公司,天津300000【正文语种】中文【中图分类】P207.20 引言目前,高等级水准测量仍然是矿区进行开采沉陷观测的主要方法,而水准网的数据处理流程繁琐且量大,大多数矿区当前使用的水准网数据处理程序或软件都不同程度的存在不足,如:程序不能自动进行闭合条件的搜索和闭合差的计算,单纯依靠人工计算,费时费力;一般的平差程序是以固定基准模型设计的,不能根据矿区的实际情况及工程本身特点选择合适的平差基准模型来处理数据[1-2];不能进行抗差处理,消除观测粗差的影响等。

VB6.0是一种可视化、面向对象的开发语言[3]，文章基于VB6.0的语言环境,进行了矿区水准网综合数据处理程序的编写,实现了对不同平差基准的水准网进行最小二乘估计和抗差估计,以及自动进行闭合环的搜索和闭合差的计算等功能,完善了矿区水准网数据处理流程,减少了作业人员的工作量,提高了工作效率。

1 数学模型1.1 平差基准模型在固定基准中,设必要观测个数为m,选取m个独立量作平差参数误差方程为[4] l=L-(AX0+d),(1)式中:为高程改正数; X0为高程的近似值。

根据最小二乘原理可知:(2)单位权中误差为[5]:(3)式中,P为观测值的权阵。

而秩亏基准和拟稳基准,网中没有必要的起算数据,此时选所有点的高程平差值为参数为参数个数且s>m.差方程的矩阵形式为[6]R(A)=m<s,秩亏数d=μ-m.给定约束条件为由最小二乘原理[7]可知:(4)式中,Qp=(ATPA+PxSSTPx)-1=(N+PxSSTPx)-1.(5)取S为ST=(1 1 … 1).当采用秩亏基准时Px=E.(6)当采用拟稳基准,(7)式中:μ2>d,μ1+μ2=μ.1.2 抗差模型程序采用等价权法进行抗差模型设计,即观测高差权阵P变为等价权阵(8)式中:Wi的计算采用IGG3函数,以固定基准为例,其抗差解为(9)当参数两次估值之差的绝对值中的最大值小于迭代精度时,迭代停止,单位权中误差为(10)式中:n0为权因子,且等于0的观测值个数。

水准网平差(VB代码)

测绘程序设计—实验八-水准网平差程序设计报告

VB测量平差程序设计讲稿

基于MATLAB的水准网和测边网平差程序设计

利用MATLAB实现水准网条件平差

水准网平差(VB代码)

vb水准

基于VB6.0的水准网抗差估计程序设计与开发

四等水准测量VB 程序 代码

平差程序核心代码(VB)

VB开发水准测量平差软件的方法

四等水准附和导线、闭合导线平差VB代码

基于MatrixVB的水准网平差程序设计

基于VB的水准网结点平差及精度评定

平面和高程控制测量VB程序设计报告

基于 VB 的水准网经典平差系统的开发与应用

水准网平差、矩阵运算MFC代码

GPS基线向量网平差VB程序设计

基于VB环境下水准网平差程序设计研究

基于VB6.0的水准网数据处理程序的实现

四等水准测量VB 程序代码