推算坐标方位角程序.doc_第1页
推算坐标方位角程序.doc_第2页
推算坐标方位角程序.doc_第3页
推算坐标方位角程序.doc_第4页
推算坐标方位角程序.doc_第5页
已阅读5页,还剩2页未读 继续免费阅读

下载本文档

版权说明:本文档由用户提供并上传,收益归属内容提供方,若内容存在侵权,请进行举报或认领

文档简介

推算坐标方位角程序分类:土建参考资料2006.9.5 20:26 作者:小杨 | 评论:0 | 阅读:1922 Option ExplicitRem * GPHVB2.VBP *Rem * 奇进偶舍、度分秒与弧度互化、推算坐标方位角程序*Rem * 2005/03/23*Private Sub Form_Load()Rem * 此为第一个窗体From1.frm *Form1.Height = Screen.Height: * 设置窗体高占整个屏幕Form1.Width = Screen.Width: * 设置窗体宽占整个屏幕Form1.Left = 0: * 设置窗体位置距离屏幕左端的距离为值零Form1.Top = 0: * 设置窗体位置距离屏幕上端的距离值为零End SubPrivate Sub GPHT1_Click(index As Integer)Rem * 奇进偶舍演示 *Rem Rem * VB提倡使用显示变量,要显示声明变量,方法有二:Rem * 1.可在类模块、窗体模块或标准模块的声明段加入如下语句:Rem * Option ExplicitRem * 2.在“工具”菜单中选取“选项”,单击“编辑器”选项卡,Rem * 再复选“要求变量声明”选项,最后单击“确定”退出,这样Rem * 就在任何新模块(类模块、窗体模块、标准模块)的声明段中Rem * 自动插入Option Explicit语句,但不会在已经建立起来的Rem * 模块中自动插入;所在工程内部,只能用手工方法向现有模Rem * 块添加 Option explicit 语句。Rem Dim A As IntegerClsPrintPrint Spc(6); 奇进偶舍演示PrintPrint Spc(6); PI()For A = 1 To 20 Print Spc(6); LTrim$(A); NNN=; NNN(PI(), A) DO Loop Until INKEY$ Next AEnd SubPrivate Function NNN(ByVal NM As Double, ByVal BB As Integer) As DoubleRem * 奇进偶舍函数 *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 (-110)If I 5 ThenK = 1ElseIf I RAD 演示*Dim D As StringClsD=0 00 00D=0 12 55D=2 12 55D = 12 36 56D=233 12 45D=-233 12 45PrintPrint Spc(6); DEG-RAD演示PrintPrint Spc(6); DEG$=; DPrint Spc(6); RAD=; RAD(D)*当$=12 36 56 时 , RAD=0.220182981*End SubPrivate Function RAD(ByVal DEGREE As String) As DoubleRem * XXXXXXX-rad *Rem * DEGREE$如12 45 18的形式*Rem * 应加上如下功能:.测试DEGREE$是否带有号;Rem * .测试度和分之间的空格之间有多少字符Dim DEG11 As DoubleDim DEG12 As DoubleDim DEG13 As Double DEG11 = Val(Left$(DEGREE, 3) DEG12 = Val(Mid$(DEGEE, 5, 2) / 60 DEG13 = Val(Right$(DEGEE, 2) / 3600 RAD = (DEG11 + DEG12 + DEG13) * PI() / 180 End FunctionPrivate Sub GPHT3_CLICK(index As Integer)Rem * RAD-DEG演示*Dim RADIAN As DoubleClsRADIAN = -2.1234PrintPrint Spc(6); RAD-DEG演示PrintPrint Spc(6); RAD=; RADIANPrint Spc(6); DEG$=; DEG(RADIAN)End SubPrivate Function DEG(ByVal RAD As Double) As StringRem *RAD-#XXXXXXX*Rem *#号表示输出XXXXXXX前应带有的符号,其若为-号,即取之;Rem * 其若为“”号,使空格顶位。Rem * 新增编一个功能:秒值输出时,可选小数点后保留的位数*Dim SIGN As Integer, WE As IntegerDim G As StringDim DEGREE As Double, DEG21 As Double, DEG31 As DoubleDim I As IntegerDim DEG1 As String, DEG2 As String, DEG3 As StringDim DEG11 As Integer, DEG22 As IntegerDim DEG33 As DoubleDim BB As IntegerRem * BB 为秒值输出时,可选小数点后保留的位数*Rem * BB 取值范围;0BB5* BB = 2: * 此为演示事例的取值* SIGN = Sgn(RAD) If SIGN 0 Then G = - Else G = DEGREE = Abs(RAD * 180 / PI() If DEGREE 0 Then DEG3 = DEG3 + . + String$(BB, 0) End IfCase Else DEG11 = Fix(DEGREE) DEG21 = (DEGREE - DEG11) * 60 DEG22 = Fix(DEG21) DEG31 = (DEG21 - DEG22) * 60 DEG33=Cint(DEG31;* 当秒值只为整数时,采用此公式 * DEG33 = NNN(DEG31, BB): *当秒值输出时,可选小数点后保留的位数时,采用此公式 * DEG1 = LTrim$(Str$(DEG11) + DEG2 = LTrim$(Str$(DEG22) DEG3 = LTrim$(Str$(DEG33) If Len(DEG2) = 1 Then DEG2 = 0 + DEG2 Else DEG2 = DEG2 If Len(DEG3) = 1 Then DEG3 = 0 + DEG3 Else DEG3 = DEG3 DEG2 = DEG2 + WE = Len(DEG1) Select Case WECase 1 DEG1 = + DEG1Case 2 DEG1 = + DEG1Case 3 DEG1 = DEG1End SelectDEG = G + DEG1 + DEG2 + DEG3End FunctionPrivate Sub GPHT7_CLICK(index As Integer)Rem *推算坐标方位角菜单子过程 *Dim TT12 As String: *声明起算坐标方位角变量Dim TTAN As Double: * 声明所推算终边的坐标方位角变量Dim N As Integer: * 声明推算坐标方位角所使用的折角个数变量N = 3: * 这里设推算坐标方位角所使用的折角个数为ReDim PP(1 To N) As String: * 声明推算坐标方位角所使用的折角变量,左折角取正号,右折角取负号TT12 = 228 06 06PP(1) = 273 12 50PP(2) = -106 47 10PP(3) = 79 34 18PP(4) = PP(5)=TTAN = RAD(TT12) + RAD(PP(1) + RAD(PP(2) + RAD(PP(3) + N * PI(): * 转换为弧度TTAN = TTAN(TTAN): * 调用Function TTNN(ByVal TTRAD As Double)函数CurrentX = 2000CurrentX = 1000Print TTAN=; DEG(TTAN, 0): * 输出的结果应为“294 06 04”End SubPrivate Function TTNN(B

温馨提示

  • 1. 本站所有资源如无特殊说明,都需要本地电脑安装OFFICE2007和PDF阅读器。图纸软件为CAD,CAXA,PROE,UG,SolidWorks等.压缩文件请下载最新的WinRAR软件解压。
  • 2. 本站的文档不包含任何第三方提供的附件图纸等,如果需要附件,请联系上传者。文件的所有权益归上传用户所有。
  • 3. 本站RAR压缩包中若带图纸,网页内容里面会有图纸预览,若没有图纸预览就没有图纸。
  • 4. 未经权益所有人同意不得将文件中的内容挪作商业或盈利用途。
  • 5. 人人文库网仅提供信息存储空间,仅对用户上传内容的表现方式做保护处理,对用户上传分享的文档内容本身不做任何修改或编辑,并不能对任何下载内容负责。
  • 6. 下载文件中如有侵权或不适当内容,请与我们联系,我们立即纠正。
  • 7. 本站不保证下载资源的准确性、安全性和完整性, 同时也不承担用户因使用这些下载资源对自己和他人造成任何形式的伤害或损失。

评论

0/150

提交评论