VB6.0物探线平面坐标推算程序设计
《Visual Basic程序设计》实验指导
《Visual Basic程序设计》实验指导廊坊职业技术学院计算机科学与工程系实验1 Visual Basic操作基础一、主要内容及目的∙掌握Visual Basic 6.0的安装和启动。
∙了解添加、删除Visual Basic 6.0的组件∙了解VB的菜单系统、工具栏和各种基本窗体。
∙理解Visual Basic 6.0开发应用程序的步骤。
二、实验内容1．启动与退出VB6.02．VB6.0的可视化编程环境(1) VB集成开发环境(2)控件工具箱(3)工程窗口(4)属性窗口(5)窗体设计窗口(6)代码窗口(7)立即窗口(8)窗体布局窗口(9)菜单栏(10)标准工具栏3．VB6.0可视化编程的步骤(1)新建一个工程(2)添加控件(3)设置属性(4)编写代码(5)运行工程(6)修改工程(7)保存工程(8)工程的编译(9)工程的打开（10）生成可执行文件4．VB6.0控件的画法(1)各种控件的画法(2)控件的缩放与移动(3)控件的复制与删除 (4)控件的布局(5)ActiveX控件的加载5．新建一个工程，在属性窗口中设置如下属性：width----6000height-----2000caption-----练习属性窗口left-----1800top-----300backcolor-----蓝色变化实验2 Visual Basic语言基础一、主要内容及目的∙掌握常量、变量的定义方法。
∙掌握各种运算符的使用方法。
∙掌握常用函数的功能及使用方法。
二、实验内容1．常量的定义方法（1）打开vb，新建工程（2）双击窗体（3）定义常量（如下图）2．变量定义(1) 打开vb，新建工程(2) 双击窗体(3) 定义变量（如下图）3．运算符的使用（1）算术运算符(+、-、*、/、\、mod、^) （2）关系运算符(>、>=、<、<=、<>、=)（3）逻辑运算符(and、or、not)（4）字符串连接符(&、+)4.常用函数的使用（1）绝对值函数（2）平方根函数（3）取整函数（4）随机函数（5）字符串长度函数（6）删除字符串空格函数（7）子串检索函数（8）取子串函数（9）日期函数（10）时间函数（11）格式输出函数（12）求ASC码函数（13）字符串转换为数值函数（14）数值转换为字符串函数实验3 命令按钮、文本框和标签一、实验目的∙掌握命令按钮、文本框和标签常用属性值的设置方法。
基于VB6.0语言的公路路线施工放样测量计算程序设计与应用研究
基于VB6.0语言的公路路线施工放样测量计算程序设计与应用研究基于VB6.0语言的公路路线施工放样测量计算程序设计与应用研究一、引言随着城市化进程的快速发展，公路建设成为城市发展的重要基础设施之一。
公路建设不仅要注重施工质量与效益，还需要保证道路的安全性和通行性。
而公路施工的核心环节之一便是放样测量，即将设计图纸上的线路准确地布设到实地中，保证工程的精度。
目前，公路放样测量通常依靠传统的手工进行，工作过程效率低下且易出现误差。
为了提高公路放样测量的精度和效率，本文设计了一款基于VB6.0语言的公路路线施工放样测量计算程序，并对其应用进行了研究。
二、程序设计与实现1. 设计要求本程序设计的主要目标是提高公路放样测量的准确度和实用性，具体要求如下：(1) 实现拓扑数据建模：将设计图纸转化为计算机可识别的拓扑数据，方便后续计算和测量处理。
(2) 自动计算测量参数：根据输入的设计图纸，自动计算出放样测量中的各项参数，包括线路长度、坡度、切线角等。
(3) 全自动放样计算：根据输入参数，自动计算出线路在实地中的布设坐标，并输出到测量仪器中，方便测量人员操作。
2. 程序实现本程序主要基于VB6.0语言进行开发，使用了数据库存储设计图纸和测量参数等信息。
具体的程序实现流程如下：(1) 图纸数据导入：将设计图纸扫描件导入系统中，使用图形识别算法将图纸中的线路、转弯等位置自动识别为拓扑数据。
(2) 参数计算：根据输入的设计图纸，程序自动计算出放样测量所需的各项参数。
例如，根据线路长度和坡度，计算出切线角和路基坡度等。
(3) 自动放样计算：根据计算得到的参数，程序自动计算出线路在实地中的布设坐标，并将坐标数据输出到测量仪器中。
(4) 测量数据处理：测量人员使用仪器进行实地测量，并将测量数据传输到计算机中。
程序根据测量数据与放样计算结果，对测量数据进行处理，判断是否满足放样要求。
(5) 结果输出与存储：根据放样计算和测量数据处理的结果，程序将最终的放样数据结果输出到打印机或存储到数据库中，方便施工人员进行实际操作。
VB环境中平面曲线的绘制与坐标轴刻度的标注
中 的 最 大 值 、最 小 值 ， 记 作 Ｖｍａｘ 和 Ｖｍｉｎ， 求 出 二 者 之 差 ， 记 作
δ＝ Ｖｍａｘ－ Ｖｍｉｎ， 总有 δ≥０。当 δ＝０ 时曲线为一条平行于坐标轴
的线段， 此时 Ｖｍａｘ＝Ｖｍｉｎ， 最 小 刻 度 值 ｌｏｗｅｒ、最 大 刻 度 值 ｕｐｐｅｒ 和 刻 度 数
ｋ 分别按式（４）、（５）和（６）进行计算。
按照式（６）计算出的刻度数 ｋ 落在［４， １１］区间上。从人机工程
学 的 角 度 来 看［４］， 这 样 设 计 出 的 刻 度 布 局 合 理 ， 人 们 在 读 图 过 程
Ｉｎｔ（ｘ）。ｆｌｏｏｒ（ｘ）和取整函数 Ｉｎｔ（ｘ）完 全 等 价 ， ｃｅｉｌ（ｘ）可 利 用 函 数 Ｉｎｔ
（ｘ）进 行 定 义 。
根据前面的理论， 本文设计了在 ＶＢ６．０ 环境中计算坐标轴
单位长度、刻度数、最小刻度值和最大刻度值的标准子程序 ＣＯ－
ＯＲＤ。 子 程 序 说 明 和 源 代 码 如 下 所 示 ：
示最小刻度值， ｕｐｐｅｒ 表示最大刻度值。
当 １≤ａ＜２ 时， 取 ｓｔｅｐ＝０．２×１０ｂ，
ｌｏｗｅｒ＝ｆｌｏｏｒ（Ｖｍｉｎ／ｓｔｅｐ）×ｓｔｅｐ
（４）
ｕｐｐｅｒ＝ｃｅｉｌ（Ｖｍａｘ／ｓｔｅｐ）×ｓｔｅｐ
（５）
ｋ＝（ｕｐｐｅｒ－ ｌｏｗｅｒ）／ｓｔｅｐ
（６）
当 ２≤ａ＜５ 时， 取 ｓｔｅｐ＝０．５×１０ｂ； 当 ５≤ａ＜１０ 时， 取 ｓｔｅｐ＝１．０×
输入变量： Ｖｍｉｎ－ 一组数据的最小值； Ｖｍａｘ－ 该组数据的最大值； 输出变量： ｓｔｅｐ－ 坐标轴的单位长度； ｌｏｗｅｒ－ 坐标轴的最小刻度； ｕｐｐｅｒ－ 坐标轴的最大刻度； ｋ－ 坐标刻度数。 Ｐｕｂｌｉｃ Ｓｕｂ ＣＯＯＲＤ（Ｖｍｉｎ Ａｓ Ｓｉｎｇｌｅ， Ｖｍａｘ Ａｓ Ｓｉｎｇｌｅ， ＿
中小学课程 《VB6.0可视化编程初探》 名师教学设计
出本节课的学习目标。
2、展示教学目标：课件展示，明确学习目标。
【学习过程】启动VB6.0,在VB集成开始环境下完成下列任务。
任务一：建立一个VB标准工程，利用工具箱中的文本框控件（TextBox)，在窗体中拖出一个适当的文本框Text1。
如图（3）设计意图：1、认识窗体图（2）。
2、熟悉文本控件（TextBox)图（3）教师活动：教师广播演示讲解！介绍窗体和文本控件的功能。
学生要求：全体学生熟悉并会操作！（2分钟）【基础任务】任务二：用同样的方法在窗体中添加两个命令按钮控件（CommandButton)、两个标签控件（Label)、一个文本框控件（TextBox)如图（4）设计意图：1、认识命令控件（CommandButton)2、重新认识标签控件（Label)教师活动：教师广播演示讲解！介绍命令控件和窗体布局注意事项及要点。
学生要求：全体学生熟悉命令控件、标签控件、文本控件并会运用操作，合理布局打字测试程序界面。
（3分钟）【基础任务】任务三：根据图（4）打字测试程序界面设计，通过图（5）的属性窗口更改对象原有属性，例如，选择“Form1”窗体，然后在属性窗口中将其“名称”属性设置值改为“frmTest”。
用同样的方法的按表2-1对象的属性设置所示改变相应的对象属性设置值。
结果如图（2-6打字测试程序的界面）设计意图：1、了解几个常用的控件前缀名的约定（表2-2）2、熟悉几个常用对象属性在VB中的含义,如:Caption对象标题（表2-3）教师活动：教师广播演示讲解！学生要求：熟悉名称、Caption、Text属性设置；各组的正、副组长指导基础差的学生完成任务三，学会分析总结。
（6分钟）【提高任务】2-6打字测试程序的界面任务四：利用代码窗口对“通用”声明、开始按钮、结束按钮进行代码简单编写如图：图2-13“通用”声明、图2-14开始按钮、图2-15结束按钮。
结果如图（6）设计意图：认识代码，了解变量（如dtmbegintime）、函数（time()、len())及事件的类别如单击（Click)、双击(Dblclick)等。
实验一VB 6.0程序设计初步_大学计算机基础实践教程（第2版）_[共2页]
![实验一VB 6.0程序设计初步_大学计算机基础实践教程（第2版）_[共2页]](https://img.taocdn.com/s3/m/4bb52aff915f804d2a16c14a.png)
第10章
程序设计基础
实验一 VB 6.0程序设计初步
一、实验学时：2学时
二、实验目的
◆学会使用VB 6.0的开发环境
◆掌握如何建立、编辑、运行一个简单的VB应用程序的全过程
◆掌握变量的概念及使用
◆掌握并理解各种控件的使用环境，并能够熟练设置控件的各种属性
◆通过程序实践结合课堂例子，理解类、对象的概念，掌握属性、事件、方法的应用
三、相关知识
Visual Basic采用的是事件驱动的编程机制，即对各个对象需要响应的事件分别编写出程序代码。
这些事件可以是用户鼠标和键盘的操作，也可以是系统内部通过时钟计时产生，甚至由程序
运行或窗口操作触发产生，因此，它们产生的次序是无法事先预测的。
所以在编写V sual Bas c
事件过程时，没有先后关系，不必像传统的面向过程的应用程序那样，要考虑对整个程序运行过
程的控制。
完成应用程序的设计后，在其中增加或减少一些对象不会对整个程序的结构造成影响。
例如，在一个窗体中增加或删除一个控件对象，对整个窗体的运行不会带来影响。
由于Vi sual Basi c应用程序的运行是事件驱动模式，是通过执行响应不同事件的程序代码进
行运行的，因此，就每个事件过程的程序代码来说，一般比较短小简单，调试维护也比较容易。
用VB 6.0进行开发应用程序的基本步骤如下。
（1）建立用户界面。
（2）设置属性。
（3）对象事件过程编写代码。
进入代码窗口方法：
①双击当前窗体（或某一控件）；
②单击工程窗口的“查看代码”按钮；
③选择“视图”菜单中的“代码窗口”命令。
117。
测绘程序设计教案VB版第十一章
第十一章演示源程序§11-1 VB6.0测量程序菜单总体演示VERSION 5.00Begin VB.Form Form1Caption = "Form1"ClientHeight = 3195ClientLeft = 165ClientTop = 855ClientWidth = 7545LinkTopic = "Form1"ScaleHeight = 3195ScaleWidth = 7545StartUpPosition = 3 '窗口缺省Begin VB.Menu WYJLCaption = "外业记录"Begin VB.Menu SZCLJLCaption = "水准测量观测记录"Begin VB.Menu PTSZJLCaption = "普通水准记录"EndBegin VB.Menu SDSZJLCaption = "四等水准记录"EndEndBegin VB.Menu SPFXJLCaption = "水平方向观测记录"Begin VB.Menu J6FXGCJLCaption = "J6方向观测法记录" EndBegin VB.Menu J6CHFJLCaption = "J6测回法记录"EndBegin VB.Menu LZF6Caption = "-"EndBegin VB.Menu J2FXGCJLCaption = "J2方向观测法记录" EndBegin VB.Menu J2CHFJLCaption = "J2测回法记录"EndEndEndBegin VB.Menu NYJSCaption = "内业计算"Begin VB.Menu ZBZSCaption = "坐标正算"EndBegin VB.Menu ZBFSCaption = "坐标反算"EndBegin VB.Menu LZF1Caption = "-"EndBegin VB.Menu JSPCCaption = "近似平差"Begin VB.Menu JHDDCaption = "交会定点"Begin VB.Menu CJDSJXZJSCaption = "测角单三角形之计算" EndBegin VB.Menu CJQFJH1ZJSCaption = "测角前方交会1之计算" EndBegin VB.Menu CJQFJH2ZJSCaption = "测角前方交会2之计算" EndEndBegin VB.Menu JWYDXJSPCCaption = "经纬仪导线近似平差"EndBegin VB.Menu DSJSJSPCCaption = "单三角锁近似平差"EndBegin VB.Menu XXSJSPCCaption = "线形锁近似平差"EndBegin VB.Menu LZF2Caption = "-"EndBegin VB.Menu DDSBXJSPCCaption = "大地四边形近似平差"EndBegin VB.Menu ZDDBX1JSPCCaption = "中点多边形1近似平差"EndBegin VB.Menu ZDDBX2JSPCCaption = "中点多边形2近似平差"EndBegin VB.Menu BWJSPCCaption = "半网近似平差"EndBegin VB.Menu LZF3Caption = "-"EndBegin VB.Menu DYSZLXJSPCCaption = "单一水准路线近似平差"Begin VB.Menu BHSZLXJSPCCaption = "闭合水准路线近似平差" EndBegin VB.Menu FHSZLXJSPCCaption = "附合水准路线近似平差" EndBegin VB.Menu ZSZLXJSPCCaption = "支水准路线近似平差" EndEndEndBegin VB.Menu YMPCCaption = "严密平差"Begin VB.Menu SZWYMPCCaption = "水准网严密平差"EndBegin VB.Menu SJGCWYMPCCaption = "三角高程网严密平差"EndBegin VB.Menu LZF4Caption = "-"EndBegin VB.Menu DXWYMPCCaption = "导线网严密平差"EndBegin VB.Menu LZF5Caption = "-"EndBegin VB.Menu CJSJWYMPCCaption = "测角三角网严密平差"EndBegin VB.Menu CBSJWYMPCCaption = "测边三角网严密平差"EndBegin VB.Menu BJTCSJWYMPCCaption = "边角同测三角网严密平差"EndEndEndBegin VB.Menu SGFYCaption = "施工放样"Begin VB.Menu JZBFDWFYYSZJSCaption = "极坐标法点位放样元素之计算" EndEndBegin VB.Menu GSTYCaption = "高斯投影"Begin VB.Menu GJLQ3DDDHCaption = "根据一点经度求3度投影带带号" EndBegin VB.Menu GJLQ6DDDHCaption = "根据一点经度求6度投影带带号" EndBegin VB.Menu LZF7Caption = "-"EndBegin VB.Menu HDJSCaption = "换带计算"Begin VB.Menu Y3DDD3DDCaption = "由3度带到3度带"EndBegin VB.Menu Y3DDD6DDCaption = "由3度带到6度带"EndBegin VB.Menu LZF8Caption = "-"EndBegin VB.Menu Y6DDD3DDCaption = "由6度带到3度带"EndBegin VB.Menu Y6DDD6DDCaption = "由6度带到6度带"EndEndEndBegin VB.Menu FFBHCaption = "分幅编号"Begin VB.Menu YBYBWBLCCaption = "1：100万比例尺"EndBegin VB.Menu YBSWBLCCaption = "1：10万比例尺"EndBegin VB.Menu YBYWBLCCaption = "1：1万比例尺"EndBegin VB.Menu LZF9Caption = "-"EndBegin VB.Menu GJYFTTHQQZWBFTTHCaption = "根据一幅图图号求其周围八幅图图号"EndEndEndAttribute VB_Name = "Form1"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalseOption ExplicitPrivate Sub form_load()Rem ***** 此为第一个窗体Form1.frm *****Form1.Height = Screen.Height: '**** 设置窗体高占整个屏幕Form1.Width = Screen.Width: '**** 设置窗体宽占整个屏幕Form1.Left = 0: '***** 设置窗体位置距离屏幕左端的距离值为零Form1.Top = 0: '***** 设置窗体位置距离屏幕上端的距离值为零End SubPrivate Function NNN(NM As Double, BB As Integer) As DoubleRem ***** 奇进偶舍函数(新版)，2002/8/2 ****Rem ***** NM为需要奇进偶舍的变量，BB为NM这个变量需要保留的小数点后面的位数 ***** Rem ***** 分别用NM=PI()、BB=1、2、......Rem ***** NM=1.2225、BB=3Rem ***** NM=1.2235、BM=3 来验证该FUNCTION过程的正确性 *****Dim BNM As DoubleDim C As IntegerDim J As IntegerDim K As IntegerDim I As DoubleC = Sgn(NM)BNM = Abs(NM)I = (BNM * 10 ^ (BB + 1) + 10 ^ (-11)) - 10 * Fix(BNM * 10 ^ BB + 10 ^ (-11)) I = (Fix(I * 10 ^ 10)) / 10 ^ 10J = Fix(BNM * 10 ^ BB + 10 ^ (-11)) - 10 * Fix(BNM * 10 ^ (BB - 1) + 10 ^ (-11))If I > 5 ThenK = 1ElseIf I < 5 ThenK = 0ElseIf (I = 5 And J = 2 * Fix(J / 2)) ThenK = 0ElseK = 1End IfNNN = C * Fix(BNM * 10 ^ BB + K) / 10 ^ BBEnd FunctionPrivate Function PI() As DoubleRem ****** 计算值 *****PI = 4 * Atn(1)End FunctionPrivate Sub PTSZJL_Click()Rem ***** 普通水准记录（演示） *****Dim A As IntegerDim I As IntegerPrintPrint Spc(6); "PI="; PI()Rem *****分别用NM=PI的值、BB=1、2、......Rem ***** NM=1.2225、BB=3Rem ***** NM=1.2235、BM=3 来验证该FUNCTION NNN(NM,BB)过程的正确性 ***** PrintFor A = 1 To 15If A <= 9 ThenI = 10ElseIf A >= 10 ThenI = 9End IfPrint Spc(6); A; Spc(I); "NNN="; NNN(PI(), A)Next AEnd SubRem ***** VB中三个取整函数的用法 *****Rem ***** INT（X）：返回小于或等于X的第一个（负）整数 *****Rem ***** FIX（X）：截断X小数点右边的所有位，返回小数点左边的值 *****Rem ***** CINT（X）：通过小数部分的四舍五入，将X转换为整数 *****Rem ***** 注意：在上述各取整函数中，X为必需参数，应为双精度数据或任何有效的数值表达式 *****Rem ***** 举例如下： *****Rem ***** CINT（45.449)=45 *****Rem ***** CINT(-2.89)=-3 *****Rem ***** FIX(45.67)=45 *****Rem ***** FIX(-2.89)=-2 *****Rem ***** INT(45.67)=45 *****Rem ***** INT(-2.89)=-3 *****Rem ***** 取整函数FIX(X)与INT(X)之间的关系式如下： *****Rem ***** FIX(X)=SGN(X)*INT(ABS(X)) *****Rem ***** 测量程序中常使用FIX（X）函数 *****§11-2 演示用Image控件Picture属性装入一个图片后，满屏显示的实现方法VERSION 5.00Begin VB.Form Form1Caption = "演示用Image控件Picture属性装入一个图片后，满屏显示的实现方法"ClientHeight = 3105ClientLeft = 60ClientTop = 435ClientWidth = 4680FillColor = &H000000FF&LinkTopic = "Form1"Picture = "Form1.frx":0000ScaleHeight = 3105ScaleWidth = 4680StartUpPosition = 3 '窗口缺省Begin mandButton Command2Appearance = 0 'FlatBackColor = &H80000016&Caption = "退出"BeginProperty FontName = "华文新魏"Size = 12Charset = 134Weight = 400Underline = 0 'FalseItalic = 0 'FalseStrikethrough = 0 'FalseEndPropertyHeight = 495Left = 9720TabIndex = 1Top = 7320Width = 1215EndBegin mandButton Command1Appearance = 0 'FlatCaption = "继续"BeginProperty FontName = "宋体"Size = 12Charset = 134Weight = 400Underline = 0 'FalseItalic = 0 'FalseStrikethrough = 0 'FalseEndPropertyHeight = 495Left = 6720TabIndex = 0Top = 7320Width = 1215EndBegin bel Label2Alignment = 2 'CenterAutoSize = -1 'TrueBackStyle = 0 'TransparentCaption = "高平和编 2001年9月25日" BeginProperty FontName = "宋体"Size = 21.75Charset = 134Weight = 400Underline = 0 'FalseItalic = 0 'FalseStrikethrough = 0 'FalseEndPropertyForeColor = &H00FF00FF&Height = 870Left = 3480TabIndex = 3Top = 5760Width = 6450WordWrap = -1 'TrueEndBegin bel Label1AutoSize = -1 'TrueBackStyle = 0 'TransparentCaption = "测量平差计算程序" DragMode = 1 'AutomaticBeginProperty FontName = "华文新魏"Size = 72Charset = 134Weight = 400Underline = 0 'FalseItalic = 0 'FalseStrikethrough = 0 'FalseEndPropertyForeColor = &H000000FF&Height = 1470Left = 240TabIndex = 2Top = 1800Width = 11520EndEndAttribute VB_Name = "Form1"Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalseOption ExplicitPrivate Sub Command1_Click()'***** 用鼠标左键点击“继续”按钮，则进入该子过程。
程序设计教案VB版第六章
第六章绘制控制网形图的程序设计方法§6-1 Visual Basic 6.0绘图基本技术计算机VB语言系统默认的屏幕（窗体）绘图坐标系的原点位于屏幕的左上角，其横轴向右为正向，纵轴向下为正向。
测量程序设计中习惯上使用测量坐标系。
要想在计算机屏幕（窗体）上建立起绘图的测量坐标系，应使其坐标原点位于屏幕的左下角，其横轴向右为正向，纵轴向上为正向。
这两种坐标系的本质区别是纵轴的方向正好相反。
为了使在屏幕（窗体）上绘出的图形与测量工作的野外实际图形方位一致（当然大小应按一定比例尺缩小），应将计算机VB语言系统默认的屏幕（窗体）绘图坐标系变换成测量坐标系；或者对计算机VB语言系统默认的屏幕（窗体）绘图坐标系不加以变换，而是将测量坐标系中的纵坐标换算成计算机VB语言系统默认的屏幕绘图坐标系中的纵坐标，横坐标保持不变。
下面先介绍这两种变换方法的第一种方法，第二种方法将在本章的第五节中介绍。
一、通过变换，在屏幕（窗体）上直接建立绘图的测量坐标系的方法1. 窗体的缺省坐标系构成一个坐标系需要三个要素：坐标原点、坐标轴度量单位、坐标轴方向。
VB坐标系统的缺省坐标原点（0，0）在对象的左上角，X坐标向右正方向，Y坐标向下为正方向。
窗体对象坐标系是由它的ScaleTop, ScaleLeft, ScaleWidth, ScaleHeight属性决定的，Scale 是“标尺”的含义。
窗体的另外四个属性，即Top, Left, Width, Height表示了窗体的大小及屏幕标准坐标系上的位置。
图6-1 窗体的缺省坐标系统图6-2 窗体在屏幕上的位置2. 控件在窗体上的坐标窗体是控件的容器，控件在窗体上的坐标是用其Top和Left属性定义的。
Width,Height 属性表示宽度和高度，它决定了控件的大小。
图6-3 控件在窗体中的位置和大小图6-4 图片容器框缺省坐标系统3. 其它控件容器的坐标系除窗体外，图片框（PictureBox)等控件也可以作为其它控件的容器使用，也具有坐标系定义。
vb课程测绘程序设计二
作业
1 角度换算程序
2 坐标方位角计算程序 3 导线测量近似坐标计算程序 4 全站仪放样元素计算程序
调用 Call recarea(10,20) recarea 10,20
5、文件操作 Open d:\dx.dat For Input As #1 打开文件
读数据 inout #1 a,b,c line input #1 a$
Open d:\dx1.dat For output As #2 打开 文件写数据
3) C点坐标计算公式: xc=xb+s*cos tbc yc=yb+s*sin tbc
4) 导线计算近似坐标,在各导线点上循环 计算.
五、全站仪放样元素计算
放样:把设计图纸上工程建筑物的平面位置和高程， 用一定的测量仪器和方法测设到实地上去的测量工作 称为施工放样(也称施工放线)。 测图工作是利用控制 点测定地面上地形特征点，缩绘到图上。施工放样则 与此相反，利用控制点，在实地上定出建筑物的特征 点，据以施工 . 公路 管线 桥梁 水电站等等都需要施工 放样.
jd4
-12
88
jd
-78.7533 -78.0755
2) 度换算度分秒 Public Function Dms( jd) [公有过程 子函数 名称(形参) ] jd1=fix(jd) jd2=(jd-jd1)*60 jd3=fix(jd2) jd4=(jd2-jd3)*60 jd=jd1+jd3/100+jd4/10000 End function
+ 字符串连接符
a$=Surveying program
Instr（） 查找子串
Left() 取左侧字符
Right() 取右侧字符
vb课程测绘程序设计二
2、计算方法 dx>0 dy>0 dx<0 dy>0 dx<0 dy<0 dx>0 dy<0 dx=0 dy>0 dx=0 dy<0 dx>0 dy=0 dx<0 dy=0
0°～90° 90°～180° 180°～270° 270°～360° 90° 270° 0° 180°
2 、度分秒与度制换算 度分秒 117°45′12″
小数形式 117.7533 1°=60′ 1′=60 ″ 1°=3600 ″ 1′=1/60° 1″=1/60 ′ 1″=1/3600 ° 1) 度分秒换算度 Public Function Deg( jd) [公有过程 子函数 名称(形参) ]
3) C点坐标计算公式: xc=xb+s*cos tbc yc=yb+s*sin tbc
第一象限 a=90°-arctan(dx/dy) 第二 象限 a=90°-arctan(dx/dy) 第三象限 a=270°-arctan(dx/dy) 第四象限 a=270°-arctan(dx/dy) a=180-Sgn(dy)*90-Atn(dx/dy)* 57.29577951308°
Public sub() dx=x(j)-x(i) dy= y(j)-y(i)+0.0000001 s=sqr(dx*dx+dy*dy) a=180-Sgn(dy)*90-Atn(dx/dy)* 57.29577951308°
测绘程序设计(二)
第二讲 简单的测绘程序设计
主要内容
一、VB程序编制基础 二、角度换算 三、坐标方位角计算 四、导线测量近似坐标计算 五、全站仪放样元素计算
一、 VB程序编制基础
基于 VB 的坐标转换程序的开发
基于 VB 的坐标转换程序的开发田继成【摘要】网上免费的坐标转换软件很多，功能各异，其中COORD功能强大、使用广泛，是坐标转换软件中的杰出代表。
尽管如此，COORD在有些情况下仍不能实现一步转换。
因此，有必要开发一种能够实现一步转换的坐标转换程序。
本文以VB 6.0为开发环境，重点阐述了开发坐标转换程序的思路和算法。
程序投入运行以来，极大地提高了坐标转换工作的效率，也有利于坐标转换成果的标准化。
%There's lots of free coordinate transformation software with different functions .As an outstanding repre-sentative of the software ,COORD is powerful and widely used .But ,in some cases ,COORD still can not achieve one-step conversion .Therefore ,it is necessary to develop a coordinate transformation program to achieve one -step conversion . Based on VB 6.0,this paper focusing on the thought and algorithms of development coordinate transformation programs . It greatly improves the work efficiency of the coordinate transformation since put into operation , and conducive to the standardization of coordinate transformation results .【期刊名称】《城市勘测》【年(卷),期】2013(000)004【总页数】4页(P71-74)【关键词】坐标转换;程序设计;模块化;VB 6.0【作者】田继成【作者单位】大同市勘察测绘院，山西大同 037000【正文语种】中文【中图分类】P226+.3坐标转换问题在测量中经常遇到，计算过程较复杂，一般使用软件计算。
利用VB实现微地形探测仪的DEM数据采集
利用VB 实现微地形探测仪的DEM数据采集任凤跃（中南大学机电工程学院湖南长沙 410083 中国）摘要：微地形探测仪是通过探测微地形表面高程数据（DEM）实现地形重构，达到对在该地形上作业的机械进行控制或实现作业可视化的一种仪器。
主要应用于水下（尤其是深海）和陆地微地形探测。
本文介绍了一种具有较高精度（厘米级）的机械式微地形探测仪的基本工作原理，重点描述了如何利用VB实现该探测仪的DEM数据采集和处理功能，还对其使用结果和误差进行了分析。
关键词：VB 微地形 探测 数据采集引言随着经济和技术的发展，人类正在以前所未有的速度向海洋开发进军。
近些年来，随着数字化的日益普及和控制精度要求的日益提高，越来越多的海底作业和采用可视化方法进行高精度过程控制的作业被提到了科技工作者的面前。
当需要探测并重构微地形，以便达到有关作业的精确控制或实现操控人员有身临其境感觉的可视化要求时，微地形探测仪就是一种不可或缺的工具。
结合国家海洋技术发展项目(DY105-03-02)，作者研究并设计出一种具有较高精度（厘米级）的机械式微地形探测仪。
本文对其基本工作原理和结构组成进行了详细的介绍，重点描述了如何利用VB实现该探测仪的数据采集和处理功能，还对其使用结果和误差进行了分析。
系统组成及工作原理该探测仪主要由探测器、数据采集及处理、微地形重构和作业控制四个部分组成。
图1 探测仪示意图工作原理为：首先将角度传感器安装到探测头的回转体内，角度传感器的外圈能随回转体自由旋转，臂式探头固定于回转体上。
探头随车辆自行在地形表面滑动时，角度传感器会随着地貌高低的起伏而进行回旋转动，输出模拟电压信号。
模拟电压信号变为数字信号后，与上位机进行通信。
通过上位机中的软件实现数据采集、地形重构和作业控制，其示意图如图1所示。
探测器探测器由若干个机械式探测头组成。
探测头数量可根据探测的地形面积大小和探测精度要求，自行增加或减少。
组装图如图2所示。
VB报告(坐标正反算使用说明)
一、输入界面1.单击VB中的“运行”快捷键，弹出图1所示的运行界面图12.在图1中选择按钮，进入坐标正算模式，如图2图2在图2中输入已知点坐标、已知点至未知点的边长和坐标方位角、保留的小数位数，点名可不输入，输入完后，选择“计算”按钮。
如要计算多个点坐标，则计算完一个点后用鼠标单击“刷新”按钮，重复以上操作即可。
若想退出坐标正算功能，用鼠标左键单击“退出”按钮，在弹出的提示框中选择“是”，如图3图33. 在图1中选择按钮，进入坐标反算模式，如图4图4在图4中输入两个已知点坐标、保留的小数位数，点名可不输入，输入完后，选择“计算”按钮。
如要计算多个点坐标，则计算完一个点后用鼠标单击“刷新”按钮，重复以上操作即可。
若想退出坐标反算功能，用鼠标左键单击“退出”按钮，在弹出的提示框中选择“是”，如图3二、输入，输出数据表格中的方位角以小数的形式输入，例如“321°18′56″“的输入格式为321.1856，若度数为321°18′56.5″的输入格式为321.18565，坐标的保留位数保留三位，别的以此类推方位角以小数的形式输入，例如“164°02′02″”的输入格式为164.0202，若度数为164°02′02.5″的输入格式为164.02025，表格中的方位角的小数保留位数为0位三、源代码Private Sub Command1_Click()If Option1.Value = True And Option2.Value = False Thenzhengsuan '当选择坐标正算按钮时调用坐标正算程序End IfIf Option1.Value = False And Option2.Value = True Thenfansuan '当选择坐标反算按钮时调用坐标反算程序End IfEnd Sub'坐标正算程序Private Sub zhengsuan()Dim s As DoubleDim a As DoubleDim x As DoubleDim y As DoubleDim m As DoubleDim n As DoubleDim degree As DoubleDim minute As DoubleDim second As DoubleDim rad As DoubleDim bbt As IntegerDim result As DoubleDim p As Doubles = Val(Text5.Text)a = Val(Text6.Text)Rad_do a, degree, minute, second, rad '调用将度分秒转化为弧度的程序x = Val(Text2.Text) + s * Cos(rad)y = Val(Text3.Text) + s * Sin(rad)p = Fix(x)x = x - pbbt = Val(Text4.Text)Sheru m, n, bbt, x, result '调用奇进偶舍程序Label12.Caption = result + pp = Fix(y)y = y - pSheru m, n, bbt, y, result '调用奇进偶舍程序Label13.Caption = result + pEnd Sub'坐标反算程序Private Sub fansuan()Dim s As DoubleDim x As DoubleDim y As DoubleDim sing As DoubleDim m As DoubleDim n As DoubleDim f As DoubleDim result As DoubleDim bbt As IntegerDim degree As DoubleDim minute As DoubleDim second As DoubleDim rad As DoubleDim p As Doublex = Val(Text5.Text)y = Val(Text6.Text)m = y - Val(Text3.Text)n = x - Val(Text2.Text)If n <> 0 Thenm = m / nrad = Atn(m)sing = Sgn(rad)End Ifdegree_m_s degree, minute, second, rad '调用将弧度转化为度分秒的程序bbt = Val(Text8.Text)m = second * 10 ^ bbtp = Fix(second)second = second - pSheru m, n, bbt, second, result '调用奇进偶舍程序second = result + pfangweijiao degree, minute, second, (x - Val(Text2.Text)), (y - Val(Text3.Text)), sing '调用计算坐标方位角的程序zhuanhua minute, second, degreesecond = second * 10 ^ bbtLabel13.Caption = degree & "." & minute & secondIf minute < 10 ThenLabel13.Caption = degree & "." & "0" & minute & secondEnd IfIf second < 10 ^ (bbt + 1) ThenLabel13.Caption = degree & "." & minute & "0" & secondEnd IfIf minute < 10 And second < 10 ^ (bbt + 1) ThenLabel13.Caption = degree & "." & "0" & minute & "0" & secondEnd If'计算边长Ss = (y - Val(Text3.Text)) ^ 2 + (x - Val(Text2.Text)) ^ 2s = Sqr(s)bbt = Val(Text4.Text)p = Fix(s)s = s - pSheru m, n, bbt, s, result '调用奇进偶舍程序Label12.Caption = result + pEnd Sub'将度分秒化为弧度Private Sub Rad_do(ByVal a As Double, ByVal degree As Double, ByVal minute As Double, ByVal second As Double, ByRef rad As Double)degree = a \ 1a = a - Fix(a)minute = Fix(a * 100)second = (a * 100 - minute) * 100rad = (3600 * degree + 60 * minute + second) / 206264.8063End Sub'将弧度转化为度分秒的程序Private Sub degree_m_s(ByRef degree As Double, ByRef minute As Double, ByRef second As Double, ByRef rad As Double)rad = rad * 180 / 3.1415926535degree = rad \ 1rad = (rad - degree) * 60minute = rad \ 1second = (rad - minute) * 60End Sub'奇进偶舍程序Private Sub Sheru(ByVal m As Double, ByVal n As Double, ByVal bbt As Double, ByVal x As Double, ByRef result As Double)m = x * 10 ^ bbtn = m - m \ 1If n < 0.5 Thenresult = (m \ 1) / 10 ^ bbtElseIf n > 0.5 Thenresult = (m \ 1 + 1) / 10 ^ bbtElseIf (m \ 1) Mod 2 Thenresult = (m \ 1 + 1) / 10 ^ bbtElseresult = (m \ 1) / 10 ^ bbtEnd IfEnd IfEnd Sub'计算坐标方位角的程序Private Sub fangweijiao(ByRef degree As Double, ByRef minute As Double, ByRef second As Double, ByVal m, ByVal n As Double, ByVal sing As Integer)Dim i As IntegerIf sing = 1 ThenIf n < 0 And m < 0 Thendegree = degree + 180End IfElseIf sing = -1 ThenIf n > 0 And m < 0 Thendegree = degree + 179minute = minute + 59second = second + 60ElseIf n < 0 And m > 0 Thendegree = degree + 359minute = minute + 59second = second + 60End IfEnd Ifi = Sgn(n)If m <> 0 ThenIf m < 0 And n = 0 Thendegree = "180"ElseIf m > 0 And n = 0 Thendegree = "0"End IfElseIf i = 1 Thendegree = "90"ElseIf i = -1 Thendegree = "270"ElseMsgBox "您输入了两个相同的点，请重新输入！"End IfEnd IfEnd Sub'当分秒超过60时须向上一级进位及方位角度数超过360°须减360°的程序Private Sub zhuanhua(ByRef minute As Double, ByRef second As Double, ByRef degree As Double)If second >= 60 Thenminute = minute + 1second = second - 60ElseIf second < 0 Thenminute = minute - 1second = second + 60End IfIf minute >= 60 Thendegree = degree + 1minute = minute - 60ElseIf minute < 0 Thendegree = degree - 1minute = minute + 60End IfIf degree >= 360 Thendegree = degree - 360End IfEnd Sub'退出程序Private Sub Command3_Click()If MsgBox("是否退出？", vbYesNo, "提示") = vbYes ThenUnload MeEnd IfEnd Sub'刷新程序Private Sub Command4_Click()Text2.Text = ""Text3.Text = ""Text4.Text = 3Text5.Text = ""Text6.Text = ""Text8.Text = 1Label12.Caption = ""Label13.Caption = ""End Sub'设置窗体的大小，使窗体充满整个屏幕并对label6和label7赋值Private Sub Form_Load()Me.Height = Screen.HeightMe.Width = Screen.WidthMe.Left = 0Me.Top = 0Label6.Caption = "边长（S）"Label7.Caption = "方位角（a）"Label17.Caption = "陈亮编程"Label18.Caption = " 2011.09.05"End Sub'设置坐标正算时Label6.Caption和Label7.Caption的值及设计小数点位数Private Sub Option1_Click()If Option1.Value = True And Option2.Value = False ThenLabel14.Caption = Text1.Text & "—>未知点" & Text7.TextLabel6.Caption = "边长（S）"Label7.Caption = "方位角（a）"Label10.Caption = "X"Label11.Caption = "Y"Text4.Text = 3Text8.Text = 1End IfEnd Sub''设置坐标反算时Label0.Caption和Label1.Caption的值及设计小数点位数Private Sub Option2_Click()If Option1.Value = False And Option2.Value = True ThenLabel6.Caption = "X"Label7.Caption = "Y"Label14.Caption = ""Label10.Caption = "边长（S）"Label11.Caption = "方位角（a）"Text4.Text = 3Text8.Text = 1End IfEnd 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版第八章
第八章导线近似平差计算程序设计§8-1 总体方案设计一般地说，编写一个测量平差计算程序，首先应进行总体方案设计，然后才是进行具体的程序代码编写及说明书编写等。
一个测量平差计算程序的总体方案设计，应包含如下内容：1、程序开始运行的图形界面，包括程序名称、编者、完成时间或版本、操作提示、警告等。
2、菜单。
一个多功能的大程序应将其用菜单形式分解为多个子功能，即子菜单。
3、输入数据提示界面。
应允许用不同方法输入数据，例如：屏幕提示、键盘输入，数据文件输入（此时应有待输入的数据文件所在路径、文件名提示或查找功能）。
输入数据完成后，应允许对已输入的数据进行核对（查看）、修改、补充或删减；还应允许对输入数据以文件形式在某个路径下存盘（保存），以便保存原始数据及重复使用。
4、计算过程设计（含各种计算方法设计）。
5、中间计算结果及最后计算结果的输出方法设计。
应允许屏幕显示、通过打印机输出或输出到文件（即以数据文件形式保存计算结果）。
6、显示、保存或通过打印机打印自动生成的网形图方法的设计。
7、点名对照表自动生成及输出设计。
§8-2 输入输出设计输入、输出方式，是一个程序与用户进行信息交互的界面。
它所设计、制作的功能如何，直接影响到程序的优劣。
一个好的程序的输入、输出方式，应具备以下特点：1、彩色界面。
色彩应用调配合适，尽可能少用具有强烈提示作用的明亮颜色，例如红色、亮黄色等要少用；对于较大区域的前景、背景，考虑到对用户眼睛的保护，应尽可能的使用绿色、墨绿色等，或使用与此相近似的自然景色图片。
2、中文提示。
3、提示所用的符号应有中文说明，并符合专业常规习惯，让人一看就懂，避免误会。
4、要求输入的信息应尽可能的少且简单。
5、必要的情况下，输入界面应配有与输入数据对应的示意图。
例如测量控制网平差计算的输入数据界面，当采用屏幕提示、键盘输入方式时，应配有具有示意作用的控制网形图，根据具体程序对输入数据的需要，对应的输入数据的提示符号应在图上明确标示。
坐标反算vb程序 流程图
Private Sub Command1_Click()Const pi As Double = 3.14159265358979Dim i As Double, a As Long, b As Long, c As Long, w As Double, n As StringDim x!, y!, d!x = Str(Val(Text2) - Val(Text1))y = Str(Val(Text4) - Val(Text3))d = (x ^ 2 + y ^ 2) ^ 0.5Text6 = Format(d, "0.00")If x = 0 Then '当x=0时程序至于这a = 90b = 270c = 0Text6 = Format(y, "0.00")If y > 0 Then ss = a & "°" & c & "′" & c & "″"Text5 = Format(ss)If y < 0 Then ss = b & "°" & c & "′" & c & "″"Text5 = Format(ss)End IfIf x <> 0 Then '当x≠0时程序继续i = Atn(y / x)w = i * 180 / piIf x < 0 And y < 0 Then '根据xy的大小于求所在象限算方位角n = w + 180ElseIf x < 0 And y > 0 Then n = 180 - wElseIf x > 0 And y < 0 Then n = 360 - wElseIf x > 0 And y > 0 Then n = wElseIf x > 0 And y = 0 Then n = 0ElseIf x < 0 And y = 0 Then n = 180End Ifa = Int(n): n = (n - a) * 60 'int（n）是取小于等于n的最大整数b = Int(n): n = (n - b) * 60c = Round(n) '四舍五入取整If c = 60 Then c = 0: b = b + 1If b = 60 Then b = 0: a = a + 1ss = a & "°" & b & "′" & c & "″"Text5 = Format(ss)End If 'End SubPrivate Sub Command2_Click() Text1 = ""Text2 = ""Text3 = ""Text4 = ""Text5 = ""Text6 = ""End SubPrivate Sub Command3_Click() EndEnd Sub。
vb坐标正算程序
vb坐标正算程序
VB坐标正算程序是一种非常实用的工具，它可以帮助我们快速计算出某个点的坐标。
在实际工作中，我们经常需要用到这种工具，比如在地图制作、测量、建筑设计等领域。
VB坐标正算程序的实现原理是利用数学公式来计算出目标点的坐标。
具体来说，我们需要知道已知点的坐标、距离和方位角，然后根据三角函数公式来计算出目标点的坐标。
这个过程需要用到VB 语言的数学函数和逻辑运算符，因此需要一定的编程基础。
在编写VB坐标正算程序时，我们需要注意以下几点：
1. 确定计算公式：根据已知点的坐标、距离和方位角，确定计算目标点坐标的公式。
这个公式需要考虑到坐标系的不同，比如笛卡尔坐标系和极坐标系的计算公式是不同的。
2. 输入数据的格式：在编写程序时，需要考虑输入数据的格式，比如坐标的单位、距离的单位、方位角的单位等。
这些单位需要在程序中进行转换，以保证计算的准确性。
3. 界面设计：为了方便用户使用，我们需要设计一个简洁明了的界面，让用户能够方便地输入数据和查看计算结果。
界面设计需要考虑到用户的使用习惯和操作流程，以提高用户的体验。
4. 错误处理：在编写程序时，需要考虑到可能出现的错误情况，比
如输入数据错误、计算公式错误等。
我们需要在程序中加入相应的错误处理机制，以避免程序崩溃或计算结果错误。
VB坐标正算程序是一种非常实用的工具，它可以帮助我们快速计算出目标点的坐标。
在编写程序时，我们需要考虑到计算公式、输入数据的格式、界面设计和错误处理等方面，以保证程序的准确性和易用性。
vb坐标正算程序
VB坐标正算程序简介VB坐标正算程序是一种用于计算地理坐标的计算机程序，使用VB语言编写。
本文将深入探讨VB坐标正算程序的原理、功能以及使用方法。
原理VB坐标正算程序基于数学和地理学的原理，通过输入已知的地理坐标和相关参数，计算出目标点的地理坐标。
其原理主要包括以下几个步骤：1. 坐标系统转换VB坐标正算程序支持不同的坐标系统，如经纬度坐标、UTM坐标等。
在进行计算之前，需要将输入的坐标转换为程序所使用的统一坐标系统。
2. 大地测量模型大地测量模型是VB坐标正算程序中的核心算法，用于计算地球上两点之间的距离和方位角。
常用的大地测量模型有球面模型和椭球模型，根据实际需求选择合适的模型进行计算。
3. 参数输入在进行坐标正算之前，需要输入已知的地理坐标和相关参数。
已知的地理坐标可以是已知点的经纬度或UTM坐标，相关参数包括大地测量模型的参数、椭球模型的参数等。
4. 坐标计算根据已知的地理坐标和相关参数，通过大地测量模型进行计算，得出目标点的地理坐标。
功能VB坐标正算程序具有以下主要功能：1. 坐标系统转换VB坐标正算程序可以实现不同坐标系统之间的转换，如经纬度坐标转换为UTM坐标，UTM坐标转换为经纬度坐标等。
通过这个功能，用户可以方便地在不同坐标系统之间进行转换。
2. 大地测量计算VB坐标正算程序可以根据已知的地理坐标和相关参数，通过大地测量模型计算目标点的地理坐标。
用户只需输入已知点的坐标和相关参数，程序即可自动计算出目标点的坐标。
3. 参数设置VB坐标正算程序提供了参数设置功能，用户可以根据实际需求设置大地测量模型的参数、椭球模型的参数等。
通过参数设置，用户可以根据实际需求进行精确的坐标计算。
4. 结果输出VB坐标正算程序可以将计算结果以文本形式输出，用户可以方便地查看计算结果。
输出结果包括目标点的经纬度坐标、UTM坐标等。
使用方法以下是VB坐标正算程序的使用方法：1. 安装程序首先，用户需要将VB坐标正算程序安装到计算机上。
VB坐标转换程序设计
Option ExplicitDim 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.14159265358979Private Sub Check1_Click()If Check1.Value = 1 ThenfrmCoorTrans.Height = 5175ElseIf Check1.V alue = 0 ThenfrmCoorTrans.Height = 4440End IfEnd SubPrivate Sub cmdBrowFile_Click()CDg1.Filter = "控制点文件(*.gcp)|*.gcp|所有文件(*.*)|*.*"CDg1.Action = 1txtFileName.Text = CDg1.FileNameEnd SubPrivate Sub cmdCalc_Click()Dim s As String, iPos%, i%, iCent!Dim n%, x1#(), y1#(), x2#(), y2#()Dim A() As Double, L() As Double, x(1 To 4) As DoubleDim At#(), Naa#(), W#()Open txtFileName.Text For Input As #1Line Input #1, sn = Val(s)ReDim x1#(n), y1#(n), x2#(n), y2#(n)For i = 1 To nLine Input #1, siPos = 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 iClose #1'计算转换参数ReDim A(1 To 2 * n, 1 To 4) As Double, L(1 To 2 * n) As DoubleReDim 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 nA(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 iDebug.Print "常数向量L："For i = 1 To 2 * nDebug.Print L(i)Next iMatrixTrans A, AtDebug.Print "A的转置矩阵："ShowMatrix AtMatrix_Multy Naa, At, ADebug.Print "Naa："ShowMatrix NaaMatrix_Multy W, At, LDebug.Print "W："For i = 1 To 4Debug.Print W(i)Next iMajorInColGuass Naa, W, xDebug.Print "X"For i = 1 To 4Debug.Print x(i)Next i'分离旋转和尺度参数If Abs(x(3)) < 0.00000001 ThenIf x(4) > 0 Thene2 = PI / 2Elsee2 = PI * 3 / 2End IfElsee2 = Atn(x(4) / x(3)) '得到的是弧度If x(3) < 0 And x(4) > 0 Thene2 = PI - e2ElseIf x(3) < 0 And x(4) < 0 Thene2 = PI + e2ElseIf x(3) > 0 And x(4) < 0 Thene2 = PI * 2 + e2End IfEnd Ifk2 = x(3) / Cos(e2)'将转换参数写入相应文本框txtK2 = Str(k2 - 1)e2 = e2 * 180 / PIDim du%, fen%du = Int(e2): e2 = (e2 - du) * 60fen = Int(e2): e2 = (e2 - fen) * 60e2 = Val(Format(e2, "0.00"))e2 = du + fen / 100# + e2 / 10000txtE2 = Str(e2)txtdX2.Text = Str(x(1))txtdY2.Text = Str(x(2))End SubPrivate Sub cmdCalc2_Click()k2 = Val(txtK2.Text)e2 = Val(txtE2.Text)e2 = DoToHu(e2)dX2 = Val(txtdX2.Text)dY2 = Val(txtdY2.Text)x2 = Val(txtX2.Text)y2 = Val(txtY2.Text)Xx2 = (k2 + 1) * (x2 * Cos(e2) + y2 * Sin(e2)) + dX2Yy2 = (k2 + 1) * (y2 * Cos(e2) - x2 * Sin(e2)) + dY2txtXx2.Text = Format(Xx2, "0.0000")txtYy2.Text = Format(Yy2, "0.0000")End SubPrivate Sub cmdCalc3_Click()k3 = Val(txtK3.Text)Ex = Val(txtEx.Text)Ex = DoToHu(Ex)Ey = Val(txtEy.Text)Ey = DoToHu(Ey)Ez = Val(txtEz.Text)Ez = DoToHu(Ez)dX3 = Val(txtdX3.Text)dY3 = Val(txtdY3.Text)dZ3 = Val(txtDz3.Text)X3 = Val(txtX3.Text)Y3 = Val(txtY3.Text)Z3 = Val(txtZ3.Text)Xx3 = (k3 + 1) * (X3 * Cos(Ey) * Cos(Ez) + Y3 * Cos(Ey) * Sin(Ez) - Z3 * Sin(Ey)) + dX3 Yy3 = (k3 + 1) * (X3 * (-Cos(Ex) * Sin(Ez) + Sin(Ex) * Sin(Ey) * Cos(Ez)) + Y3 * (Cos(Ex) * Cos(Ez) + Sin(Ex) * Sin(Ey) * Sin(Ez)) + Z3 * (Sin(Ex) * Cos(Ey))) + dY3Zz3 = (k3 + 1) * (X3 * (Sin(Ex) * Sin(Ez) + Cos(Ex) * Sin(Ey) * Cos(Ez)) + Y3 * (-Sin(Ex) * Cos(Ez) + Cos(Ex) * Sin(Ey) * Sin(Ez)) + Z3 * (Cos(Ex) * Cos(Ey))) + dZ3txtXx3.Text = Format(Xx3, "0.0000")txtYy3.Text = Format(Yy3, "0.0000")txtZz3.Text = Format(Zz3, "0.0000")End SubPrivate Sub cmdClear2_Click()txtX2.Text = ""txtY2.Text = ""txtXx2.Text = ""txtYy2.Text = ""End SubPrivate Sub cmdClear3_Click()txtX3.Text = ""txtY3.Text = ""txtZ3.Text = ""txtXx3.Text = ""txtYy3.Text = ""txtZz3.Text = ""End SubPrivate Sub cmdconCalc2_Click()k2 = Val(txtK2.Text)e2 = Val(txtE2.Text)e2 = DoToHu(e2)dX2 = Val(txtdX2.Text)dY2 = Val(txtdY2.Text)Xx2 = Val(txtXx2.Text)Yy2 = Val(txtYy2.Text)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 SubPrivate Sub cmdconCalc3_Click()k3 = Val(txtK3.Text)Ex = Val(txtEx.Text)Ex = DoToHu(Ex)Ey = Val(txtEy.Text)Ey = DoToHu(Ey)Ez = Val(txtEz.Text)Ez = DoToHu(Ez)dX3 = Val(txtdX3.Text)dY3 = Val(txtdY3.Text)dZ3 = Val(txtDz3.Text)Xx3 = Val(txtXx3.Text)Yy3 = Val(txtYy3.Text)Zz3 = Val(txtZz3.Text)X3 = ((Xx3 - dX3) * Cos(Ey) * Cos(Ez) + (Yy3 - dY3) * (-Cos(Ex) * Sin(Ez) + Sin(Ex) * Sin(Ey) * Cos(Ez)) + (Zz3 - dZ3) * (Sin(Ex) * Sin(Ez) + Cos(Ex) * Sin(Ey) * Cos(Ez))) / (k3 + 1) Y3 = ((Xx3 - dX3) * Cos(Ey) * Sin(Ez) + (Yy3 - dY3) * (Sin(Ex) * Sin(Ey) * Sin(Ez) + Cos(Ex) * Cos(Ez)) + (Zz3 - dZ3) * (-Sin(Ex) * Cos(Ez) + Cos(Ex) * Sin(Ey) * Sin(Ez))) / (k3 + 1)Z3 = ((Xx3 - dX3) * (-Sin(Ey)) + (Yy3 - dY3) * Sin(Ex) * Cos(Ey) + (Zz3 - dZ3) * (Cos(Ex) * Cos(Ey))) / (k3 + 1)txtX3.Text = Format(X3, "0.0000")txtY3.Text = Format(Y3, "0.0000")txtZ3.Text = Format(Z3, "0.0000")End SubPrivate Sub cmdExit_Click()EndEnd SubPrivate Sub Form_Load()frmCoorTrans.Height = 4440End Sub'弧度化为度.分秒的形式：输入弧度值，输出度.分秒（各占两位）Public Function HuToDo(ByVal Hu As Double) As SingleDim 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 IfHuToDo = du + fen / 100 + miao / 10000End Function'将度.分秒形式化为弧度：输入为度.分秒形式，输出为弧度Public Function DoToHu(ByVal DoFenMiao As Double) As SingleDim 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, At)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 C1At(j, i) = A(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 SubPublic 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'列选主元法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 iRowNext 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 SubDim iMark% '测站计数器Dim dist!, dH!Private Sub cmdCancel_Click()'清除已经传给主窗体的数据Dim i%For i = 1 To iMarkdis(i) = 0detH(i) = 0Next i'清除主窗体的显示frmMain.txtShowResult.Text = "水准计算结果:"'卸载输入窗体Unload MeEnd SubPrivate Sub cmdOK_Click()dist = Val(txtDist.Text)dH = Val(txtDetH.Text)Call AddData(iMark, dist, dH)'在主窗体显示本站数据frmMain.txtShowResult = frmMain.txtShowResult & "第" & Str(iMark) & "站：" & vbCrLf frmMain.txtShowResult = frmMain.txtShowResult & " 距离：" & dis(iMark) & " 高差中数：" & detH(iMark) & vbCrLfIf iMark >= nMarks Then '如果已经输入完所有的测站观测值frmInput.HideElse '若还没有输完，初始化输入界面输入下一个测站txtDist.Text = ""txtDetH.Text = ""txtDist.SetFocusEnd IffrmInput.Caption = "观测数据输入：第" & Trim(Str(iMark)) & "站"iMark = iMark + 1 '测站数加1End SubPrivate Sub Form_Load()iMark = 1End SubDim iMark% '测站计数器Dim dist!, dH!Private Sub cmdCancel_Click()'清除已经传给主窗体的数据Dim i%For i = 1 To iMarkdis(i) = 0detH(i) = 0Next i'清除主窗体的显示frmMain.txtShowResult.Text = "水准计算结果:"'卸载输入窗体Unload MeEnd SubPrivate Sub cmdOK_Click()dist = Val(txtDist.Text)dH = Val(txtDetH.Text)Call AddData(iMark, dist, dH)'在主窗体显示本站数据frmMain.txtShowResult = frmMain.txtShowResult & "第" & Str(iMark) & "站：" & vbCrLf frmMain.txtShowResult = frmMain.txtShowResult & " 距离：" & dis(iMark) & " 高差中数：" & detH(iMark) & vbCrLfIf iMark >= nMarks Then '如果已经输入完所有的测站观测值frmInput.HideElse '若还没有输完，初始化输入界面输入下一个测站txtDist.Text = ""txtDetH.Text = ""txtDist.SetFocusEnd IffrmInput.Caption = "观测数据输入：第" & Trim(Str(iMark)) & "站"iMark = iMark + 1 '测站数加1End SubPrivate Sub Form_Load()iMark = 1End SubOption ExplicitOption Base 1Dim sAngle() As Double, sdAngle() As Double, sEdge() As DoubleDim detX() As Double, detY() As Double, reX() As Double, reY() As DoubleDim strFileName As StringDim iType%, Xa#, Ya#, Xb#, Yb#, Xc#, Yc#, Xd#, Yd#Dim iStation As IntegerDim detA As Double '角度闭合差Dim detTX#, detTY#, detTT#, Tedge# 'X坐标闭合差、Y坐标闭合差、总体闭合差、路线长Const PI = 3.141592653Private Sub mnuAbout_Click()Form2.Show 1End SubPrivate Sub mnuCalc_Click()'计算坐标方位角Dim aAB#, aDC#Dim i%aAB = DirectAB(Xa, Ya, Xb, Yb)txtShow.Text = txtShow.Text & vbCrLf & "起始坐标方位角" & Format(HuToDo(aAB), "0.0000")If iType = 1 ThenaDC = DirectAB(Xc, Yc, Xd, Yd)txtShow.Text = txtShow.Text & vbCrLf & "终止坐标方位角" & Format(HuToDo(aDC), "0.0000")ElsetxtShow.Text = txtShow.Text & vbCrLf & "终止坐标方位角" & Format(HuToDo(aAB), "0.0000")End If'推算坐标方位角，把推算得到的方位角初值给sdAngle数组sdAngle(1) = aABtxtShow.Text = txtShow.Text & vbCrLf & "方位角初值：" & vbCrLfFor i = 1 To iStationsdAngle(i + 1) = sdAngle(i) + PI - sAngle(i)txtShow.Text = txtShow.Text & Format(HuToDo(sdAngle(i)), "0.0000") & " , "Next itxtShow.Text = txtShow.Text & Format(HuToDo(sdAngle(i)), "0.0000") & vbCrLf'计算角度闭合差If iType = 1 ThendetA = sdAngle(i) - aDCElsedetA = sdAngle(i) - aABEnd IftxtShow.Text = txtShow.Text & Format(HuToDo(detA), "0.0000") & vbCrLf'判断是否附合限差要求If detA > Int(40 * Sqr(iStation)) ThenMsgBox "角度闭合差超限！", , "计算终止"txtShow.Text = txtShow.Text & vbCrLf & "角度闭合差超限，计算终止！"Exit SubEnd If'若没有超限，则分配角度闭合差，重新计算角度值和推算坐标方位角detA = detA / iStation '简单地平均分配角度值了，后面对秒进行四舍五入处理txtShow.Text = txtShow.Text & "改正后的角度：" & vbCrLfFor i = 1 To iStationsAngle(i) = sAngle(i) + detAtxtShow.Text = txtShow.Text & Format(HuToDo(sAngle(i)), "0.0000") & " , "sdAngle(i) = sdAngle(i) + detA * (i - 1)Next itxtShow.Text = txtShow.Text & vbCrLf & "改正后的方位角：" & vbCrLfFor i = 1 To iStationtxtShow.Text = txtShow.Text & Format(HuToDo(sdAngle(i)), "0.0000") & " , "Next itxtShow.Text = txtShow.Text & vbCrLf'计算初始坐标增量txtShow.Text = txtShow.Text & "坐标增量初值：" & vbCrLfFor i = 2 To iStationdetX(i - 1) = sEdge(i - 1) * Cos(sdAngle(i))txtShow.Text = txtShow.Text & Format(detX(i - 1), "0.000") & " , "detY(i - 1) = sEdge(i - 1) * Sin(sdAngle(i))txtShow.Text = txtShow.Text & Format(detY(i - 1), "0.000") & " ; "Next itxtShow.Text = txtShow.Text & vbCrLf'计算坐标闭合差reX(1) = Xb: reY(1) = Yb: Tedge = 0For i = 2 To iStationreX(i) = reX(i - 1) + detX(i - 1)reY(i) = reY(i - 1) + detY(i - 1)Tedge = Tedge + sEdge(i - 1)Next iIf iType = 1 ThendetTX = reX(iStation) - XcdetTY = reY(iStation) - YcElsedetTX = reX(iStation) - XbdetTY = reY(iStation) - YbEnd IfdetTT = Sqr(detTX * detTX + detTY * detTY)txtShow.Text = txtShow.Text & "坐标闭合差：detX " & Format(detTX, "0.000") & " , detY " & Format(detTY, "0.000")txtShow.Text = txtShow.Text & " , ddetTotal " & Format(detTT, "0.000") & vbCrLfIf Abs(detTT / Tedge) > 1 / 2000 ThenMsgBox "坐标闭合差超限！", , "计算终止"txtShow.Text = txtShow.Text & "边长精度为1/" & Str(Fix(Tedge / detTT)) & "超过限差，计算终止！"Exit SubEnd IftxtShow.Text = txtShow.Text & "边长精度为1/" & Str(Fix(Tedge / detTT)) & "附合要求。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
现在地质及 测量部 门经常使用 的成 图软 件有 ＭＡ ＧＩ Ｐ Ｓ和加 载在 Ｃ ＡＤ基础上的南方 Ｃ Ｓ 图系统 ， Ａ Ｓ成 都不具备按线的方 向和 间距提取大量坐标数据的功能 ， 为此本人用 Ｖ ６ ０软件 编制了一 Ｂ． 个推算物探线平 面坐标数据的应用程序 ， 推算后 生成的数据文件
Ｖ ６ ０物 探 线 平 面 坐 标 推 算 程 序 设 计 Ｂ．
王 宝 江
摘 要： 通过实例用 ＶＢ ． ６ ０编程分析 了物探 线平面坐标数据 的推算方法 ， 结合加 载在 Ｃ ＡＤ基础上的 南方 Ｃ Ｎ Ａ Ｓ成图系
统实现 了大量数据 坐标 的快速提取和展绘 ， 总结了该类程序的设 计、 使用方法， 检核 了软件精度 。 关键词 ： 物探线 ， Ｏ Ｐ Ｄ．ｘ ， Ｂ ． Ｎ Ｔ Ａ ａｅＶ ６０软件 ， 南方 Ｃ Ｓ Ａ Ｓ成图系统 中图分类号 ： Ｕ１ ８ Ｔ ９ 文献标识码 ： Ａ
Ｐ Ｄ．ｘ 打开一个名称为 Ｔ ｍｐｄ ｔ Ａ ｅｅ ｅ ．ａ 的数据文 件。 Ｔ ｒｐｄ ｔ ｅ ．ａ 会在下 一次 推算数 据时被 刷新 ， ｎ 故推 算数 据在 确
点击 以上复选框 ， 弹出如图 ３所示表单。
以下为线 上点坐标增量计算 程序 的主要代码 ：
Ｐｉ ｔ ｕ ｏ ｒ ａｅ ｂＣ ｍｍａｄ ｌ ｋ ） ｖ Ｓ ｎ ｌ ｉ （ Ｃｃ
为南方 Ｃ Ｓ Ａ Ｓ数据 的． Ａ Ｄ Ｔ格式 ， 以在南方 Ｃ Ｓ 可 Ａ Ｓ成 图软件 中 直接展绘。
Ｄ ｍ“ ｅ 以下为测量方位角转换为数学方位角。 ”
Ｃ ＝３． ４ ５ ２ ５ ５ ９ ９ ／２ 一 Ｃ １ １９ ６ ３８ ７ Ｃ
Ｄ ｍ“ ｅ 进行坐标增量计算 ， Ｘ ｌ 如 ｚ 对应于线上点的 Ｘ增量 。 ”
Ｆ ｒ ． ｚ． ｅｔ＝ Ｃ ￣ｃ ｏｍ１Ｘ １ ｘ Ｔ ｏ（）＊ Ｆ ｒ ２ ｄ ｏｍ ．ｉ ｇ
Ｆ ｒ ． ｚ． ｅｔ＝ Ｓｎ ｃ ＊ Ｆ ｒ ２ ｄ ｏｍ１Ｙ １ ｘ Ｔ ｉ（） ｏｍ ．ｉ ｇ Ｆ ｒ ／ Ｘ ｇＴ ｘ ｏｍ ． ｊ． ｅ ｔ＝ Ｃ ｓ （ ＋ ３ １ １９ ６ ３８ ７ ／２ ） ＊ ｏ（Ｃ ． ４５ ２ ５ ５ ９９ ）
Ｄｉ Ｃ ｍ Ｄｉ Ｃ ｍ Ｃ
信正确无误后 ， 应及时另存且不可与 Ｔｅ ．ａ 重名。 ｍｐ ｄｔ
收稿 日期 ：０ ９１ —６ ２ ０ ．２１ 作者简介 ： 王宝江（ ９ ５ ） 男， １７ ． ， 助理工程师 ， 河北省地勘局秦皇岛矿产水文工程地质大 队， 河北 秦皇岛 ０ ６０ ６０ １
１ ０） ＊ １ ０ ０ ） ０ ）／２ ６ ６ ８ ０ ２ ４． １
Ｂ． ” 地质部 门的测量 任务 中有 许多 是关于物探 线 的测 量定线 问 Ｖ ６ ０要求的弧度格式 。
ｘ） ０） ０ ｆ ｊＴ ｘ ０ ｎ （ｗ ． ｅｔ 据量很大 ， 如何提取每条线的平面放样数 据就成为摆在地质测 量 Ｔｅｔ） ＊ １０ ＊ ６ ＋ （ｗ ． ｅｔ ＊ １０ 一 Ｉｔｆ ｊＴ ｘ ＊
１ 问题的提 出
题， 按测量学 分类属 于直线的测设 问题 。该 类问题放样 点、 线数
人员面前急需解决的问题 。
Ｄｅ 以下为将测量 的方位 角 ： 、 、 （ 东格 式） ｍ“ 度 分 秒 北 装换 为
ｃ ｃ＝ （ｎ（ｗ ． ｘ） ＊ ３ ０ ＋ Ｉｔ （ｗ ． ｅｔ— Ｉｔｆｊ ＩｔｆｊＴｅｔ ６０ ｎ （ｆｊＴ ｘ ｎ（ ． ｗ
Ｆ ｒ ．ｊ ｏｍ２ ｘｇ
２ 处理思 路
物探线一般要求 ５ｍ，０ｍ 的点距 ， １ 长度可达几千米 ， 假定 一 条 １ｋ ｍ的物探 线点距 ５ｍ， 则要 测设 ２ １个点位 。线距 一般 有 ０ ５ １０ｍ不等。而直线 由起点和终点唯一确 定直线 的方 向和 ０ｍ，０ 距 离。有了线的起 点坐标 和方位角 就可 以按 下式计算 间隔点 的 坐标 ： 问隔点的 ｘ（ ｙ） 或 坐标 ＝起始点 ｘ（ ｙ） 或 坐标 ＋Ｘ（ ｙ） 或
・
３２ ・ ５
第３ ６卷 第 ９期 ２０ １ ０年 ３月
山 西 建 筑
Ｓ ＨＡＮＸＩ ＡＲＣＨＩ Ｂ ＴＵＲＥ Ｔ Ｃ
Ｖ０＿ ６Ｎｏ ９ Ｉ３ ．
Ｍａ． ２ ０ ０ —３ ２０ １０ ：８５ ２ １ ）９０ ５ —２
输入起始点坐标 ｌ ｌ 输入要推算的点、 线数 图 ２ 程 序 主界 面 图 ３ 弹 出 表单
给定点、 线间距和方 向 间隔点的增量计算 推算结果保存 到文本文件
图 １ 程 序 结 构 示意 图
３ 具体 实现
程序主界面见 图 ２ 。
图 ４ 输 入 数 据 示例
以上示例 中线号选择了按偶数增加 。 输入必要的数据 后先 点 击“ 推算 坐标 ” 再点 击 “ 显示 结果 ” 。 本软件 用 Ｗｉ ｏ ｓ 作 系 统 下普 遍 使 用 的文 本 编辑 器 Ｎ — ｎ ｗ操 ｄ ＯＴ
方向的坐标增量 ｘ（ 问隔点号 一 起始点号 ） ；
Ｆ ｒ ． ｊ． ｘ ｏｍ１Ｙｇ Ｔｅｔ＝ Ｓｎ （ ＋ ３ １ １ ９６ ３ ８ ７ ／２ ） ＊ ｉ（ｅ ．４ ５ ２ ５ ５９ ９ ）
Ｆ ｒ ．ｊ ｏｍ２ ｘｇ
Ｅｎ ｕ ｄＳ ｂ
，
Ｆ ｒ ． ｚ Ｖ ｌｅ＝ ０ ｏｍ１ ｊ １ ａ ｓ． ｕ
主表单 的程序相对简单 ， 故不赘述。 输入全部数据的示例见图 ４ 。
现在 的关键是按点距 Ｄ 和线 的方位 角 要求算 出ｘ 方 向和
ｙ方向的坐标增量 △ Ａｙ。 Ｘ，
Ａ ＝Ｄ ×ｃｓａ ； Ｘ ｏ（ ）Ａｙ＝Ｄ ×ｓ （ 。 ｉ ） ｎ
注意 ： 数学坐标格式 为 ： ｙ与南方 Ｃ Ｓ ｘ， ＡＮ 格式 中坐标格式 相 同， 但在实际应用中的测量 坐标格式为北 Ｎ， Ｅ格式。 东 程序结构示意 图见 图 １ 。