测量方位角计算公式VB源代码

测量方位角计算公式VB源代码 角度化弧度 Public Function Radian(a As Double) As Double Dim Ra As Double Dim c As Double Dim FS As Double Dim Ib As Integer Dim Ic As Integer Ra = pi / 180# Ib = Int(a) c = (a - Ib) * 100# Ic = Int(c) FS = (c - Ic) * 100# Radian = (Ib + Ic / 60# + FS / 3600#) * Ra End Function ‘弧度化角度 Public Function Degree(a As Double) As Double Dim B As Double Dim Fs1 As Double Dim Im1 As Integer Dim Id1 As Integer B = a Call DMS(B, Id1, Im1, Fs1) Degree = Id1 + Im1 / 100# + Fs1 / 10000# End Function Public Sub DMS(a As Double, ID As Integer, IM As Integer, FS As Double) Dim B As Double Dim c As Double c = a c = 180# / pi * c ID = Int(c + 0.0000005) B = (c - ID) * 60 + 0.0005 IM = Int(B) FS = (B - IM) * 60 End Sub ‘计算两点间的方位角 Public Function azimuth(x1 As Double, y1 As Double, x2 As Double, y2 As Double) As Single Dim dx As Double Dim dy As Double Dim fwj As Double dx = x2 - x1 dy = y2 - y1 If dy <> 0 Then fwj = pi * (1 - Sgn(dy) / 2) - Atn(dx / dy) azimuth = Degree(fwj) Else If dx > 0 Then azimuth = 0 Else azimuth = 180 End If End If End Function 5.2程序字母代表含义 La—起点里程， R—圆曲线半径，l0—两端缓和曲线长，α—曲线转向角，T—切线长，L—曲线长，E0—外矢距，q—切曲差，cc—线路转向(cc=1时，线路向右转;cc=-1时，线路向左转),d―桩距，m―边桩距，Li―i点的里程，ZH― QZ―曲中点，YZ―圆直点，YH―圆缓点，直缓点，HY―缓圆点，JD―交点， HZ―缓直点，LJD—交点里程，LZH― 直缓点里程，LHY―缓圆点里程，LQZ―曲中点里程，LYH―圆缓点里程，LHZ―缓直点里程。 5.3程序设计思路及具体程序的编写 程序的基本构思:本程序利用已知直、曲线要素、交点坐标，计算出曲线上逐桩坐标，根据逐桩坐标就可实地放样。此程序在不同测站测设同一曲线时，调用程序只需改变测站和后视点坐标即可。不过测站点和后视点的坐标系统与 逐桩坐标系统必须一致。 程序设计中主要发现的问题及解决办法: 5.3.1 起点为非整桩的情况 本程序采用将非整桩起点的坐标通过变换成为整桩的方法。 直线起点 L1=Int((la / 10) * 10 + k) 第一缓和曲线 L2=Int(Ljd – T + K) 圆曲线 L3=Int(Ljd - T + lo + K ) 第二缓和曲线 L4=Int(Ljd - T + L – lo + K ) 并计算出这些点的坐标。 表5.1 起点是否整桩的判断 5.3.2 路线方位角的计算 程序中采用的起算数据中不包含方位角一项，因此必须要由已知的两点坐标计 算出线路的方位角。 本程序中利用ZH点和JD的坐标计算。建立一个计算方位角的模块: Function αab#(Xa#, Ya#, Xb#, Yb#) αab = Atn(Abs(Yb - Ya) / Abs(Xb - Xa)) If Yb - Ya >= 0 And Xb - Xa >= 0 Then αab = αab ElseIf Yb - Ya > 0 And Xb - Xa < 0 Then αab = 3.141592654 - αab ElseIf Yb - Ya <= 0 And Xb - Xa <= 0 Then αab = 3.141592654 + αab Else αab αab = 2 * 3.141592654 - End If End Function αab——某点的方位角，Xa ——起点X坐标(ZH或ZY点坐标)，Ya——起点 Y坐标(ZH或ZY点坐标)， 终点X坐标(JD的X坐标)，Yb——终点Y坐标(JD的Y坐标) Xb—— 5.3.3 计算曲线边桩坐标的程序 Xi = x0 + Xxi * Cos(A0) - cc * Yyi * Sin(A0) ‘i点的X坐标 Yi = y0 + Xxi * Sin(A0) + cc * Yyi * Cos(A0) ‘i点的Y坐标 Ai = A0 + cc * β Xz = Xi + m * Cos(Ai - 3.141592654 / 2) ‘左边桩X坐标 Yz = Yi + m * Sin(Ai - 3.141592654 / 2) ‘左边桩Y坐标 Xy = Xi + m * Cos(Ai + 3.141592654 / 2) ‘右边桩X坐标 Yy = Yi + m * Sin(Ai + 3.141592654 / 2) ‘右边桩Y坐标 A0计算参考起点的方位角，Ai为计算点的方位角，m为边桩距，Xi为计算点 的;, Left(xil, 10), Left(yil, 10) Print #1, "K+"; li; "中 桩", Left(Xi, 10), Left(Yi, 10) ‘保存为TXT 格式 pdf格式笔记格式下载页码格式下载公文格式下载简报格式下载 文档 Print #1, "K+"; li; "右边桩", Left(xir, 10), Left(yir, 10) Print #1, Close #1 Open "C:\Documents and Settings\Administrator\桌面\道路放样\计算结果\ 直线.dat" For Append As #1 Print #1, , "K+" & li; ",,"; Left(xil, 10); ", "; Left(yil, 10); ","; 0 Print #1, , "K+" & li; ",,"; Left(Yi, 10); ","; Left(Xi, 10); ","; 0 ‘保存DAT格式文档 Print #1, , "K+" & li; ",,"; Left(xir, 10); ","; Left(yir, 10); ","; 0 Print #1, Close #1 ―K+‖表示桩号，li表示里程，xi,yi,xil,yil, xir,yir分别表示计算点的中边桩坐标。Left()表示取计算成果的钱10位 有效数字。 在编写程序的时候，成果保存的关键词有Append,Output等，在第一次保存时用Output，目的是清除以前的旧项目数据;在同一段曲线以后计算保存中用Append，目的是在前面基础上继续添加数据，使原来的数据不被替代。 Open "C:\Documents and Settings\Administrator\桌面\道路放样\计算结果\第一缓和曲线.txt" For Input As #1 Do While Not EOF(1) ‘文本框显示计算的数据 Line Input #1, inputdata Text5.Text = Text5.Text + inputdata + vbCrLf Loop Close #1 5.3.5 引用CAD成图的方法 将计算结果输入到【成图数据】文件中，采用【X,Y,Z】的格式一行一行的存储在TXT文 首先引用―AutoCAD 2000 Object Library‖，然后输入以下语句: Dim appcad As Object ‘建立Application对象 Dim acadDoc As Object ‘建立Document对象 Dim mospace As Object ‘建立Model Space对象 Set appcad = CreateObject("autocad.application") If Err Then Err.Clear ‘调用CAD On Error Resume Next ‘容错 Set appcad = CreateObject("autocad.application") If Err Then Err.Clear MsgBox "不能运行AutoCAD,请检查是否安装～", vbOKCancel, "警告～" Exit Sub End If End If appcad.Visible = True ‘CAD显示 Set acadDoc = appcad.ActiveDocument Set mospace = acadDoc.ModelSpace Dim stp(0 To 2) As Double Dim etp(0 To 2) As Double Dim fname As String fname = "C:\Documents and Settings\Administrator\桌面\道路放样\成图数据\直线 中.txt" ‘CAD成图 Open fname For Input As #1 ‘打开数据文件 Input #1, stp(0), stp(1), stp(2) Do While Not EOF(1) Input #1, etp(0), etp(1), etp(2) Call mospace.AddLine(stp, etp) stp(0) = etp(0) stp(1) = etp(1) stp(2) = etp(2) Loop Close #1 5.3.6 计算的数据输出到全站仪的格式问题 软件结合公路放样的实例编制，根据实际工作需要，采用手工输入。程序输出采用TXT文挡和DAT文档。TXT文档便于进行打印查询及检查。DAT文档易于将数据传输到全站仪直接进行方放样工作。除此以外,DAT格式的文档还 可直接导入到AUTOCAD中进行道路的成图,完成各种动态 报表 企业所得税申报表下载财务会计报表下载斯维尔报表下载外贸周报表下载关联申报表下载 的绘制与输出。 经过学习经验和对仪器的考察，DAT文件的格式在本程序采用―点名，编码，Y,X,Z‖的格式输出。 >反算,>正算后，Y坐标与原来的差了0.5,0.7mm，不知道怎么回事，这两年工作忙也没有时间再深究，但是这样的计算精度做控制足够了，如果楼主或是者是哪位同仁见此贴能顺便把这个问题解决了，咱们就一起进步了～代码如下: ‘高斯坐标正算 Private Sub DadiZs() Dim t As Double, Itp As Double, X0 As Double, N As Double, L0 As Double Dim V As Double, ll As Double, W As Double, M As Double Lat = Radian(Lat) Lon = Radian(Lon) L0 = Radian(Lo) If Tq = 0 Then a = 6378245 ‘54椭球参数 b = 6356863.01877305 ep = 0 ‘高斯反算 Private Sub DadiFs() Dim t As Double, Itp As Double, X0 As Double, Bf As Double, N As Double Dim v As Double, ll As Double, W As Double, M As Double, L0 As Double L0 = Radian(Lo) X0 = x * 0.000001 y = y - 500000# If Tq = 0 Then aegree(Lat) Lon = Degree(L0 + ll) r = Degree(r) End Sub 有了正反算，换带也就完成了～ 用到的子程序: Public Const Pi = 3.14159265358979, p = 206264.806 Public Cktq As String ‘角度化弧度 Public Function Radian(a As Double) As Double Dim Ro As Double Dim c As Double Dim Fs As Double Dim Ib As Integer Dim Ic As Integer If a < 0 Then a = -a: t = 1 Ro = Pi / 180# Ib = Int(a) c = (a - Ib) * 100# Ic = Int(c + 0.000000000001) Fs = (c - Ic) * 100# If t = 1 Then Radian = -(Ib + Ic / 60# + Fs / 3600#) * Ro Else Radian = (Ib + Ic / 60# + Fs / 3600#) * Ro End Function ‘弧度化角度 Public Function Degree(a As Double) As Double Dim Bo As Double Dim Fs As Double Dim Im As Integer Dim Id As Integer If a < 0 Then a = -a: t = 1 Bo = a Call DMS(Bo, Id, Im, Fs) If t = 1 Then Degree = -(Id + Im / 100# + Fs / 10000#) Else Degree = Id + Im / 100# + Fs / 10000# End Function Public Sub DMS(a As Double, Id As Integer, Im As Integer, Fs As Double) Dim Bo As Double Dim c A[标签:内容]