曲线任意里程中边桩坐标正反算(VB6.0)函数(5节点法提供测试程序代码）

概要： d = (xyb(6) - xyb(7)) / 2# / xyb(5) / xyb(6) / xyb(7) ft = f0 - 0.5 * pi w = Abs((xpt(2) - xyb(3)) * Cos(ft) - (xpt(1) - xyb(2)) * Sin(ft)) z = 1 'Txt1.Text = Txt1.Text + "S0=" + Str(xyb(1)) + Chr(13) + Chr(10) Do While Abs(z) > 0.000001 sz(1) = xyb(1) + w: sz(2) = z Call qxzs(xyb(), sz(), fhb()) ff = ft + q * w * (c + w * d) z = (xpt(2) - fhb(2)) * Cos(ff) - (xpt(1) - fhb(1)) * Sin(ff) w = w + z Loop sz(1) = xyb(1) +

曲线任意里程中边桩坐标正反算(VB6.0)函数(5节点法提供测试程序代码）,标签：工程测量规范,工程测量技术,http://www.67jzw.com
   d = (xyb(6) - xyb(7)) / 2# / xyb(5) / xyb(6) / xyb(7)
   ft = f0 - 0.5 * pi
   w = Abs((xpt(2) - xyb(3)) * Cos(ft) - (xpt(1) - xyb(2)) * Sin(ft))
   z = 1
  
   'Txt1.Text = Txt1.Text + "S0=" + Str(xyb(1)) + Chr(13) + Chr(10)
  
   Do While Abs(z) > 0.000001
      sz(1) = xyb(1) + w: sz(2) = z
      Call qxzs(xyb(), sz(), fhb())
      ff = ft + q * w * (c + w * d)
      z = (xpt(2) - fhb(2)) * Cos(ff) - (xpt(1) - fhb(1)) * Sin(ff)
      w = w + z
   Loop
  
    sz(1) = xyb(1) + w: sz(2) = 0
    Call qxzs(xyb(), sz(), fhb())
    
    fhb(1) = xyb(1) + w
    fhb(2) = (xpt(2) - fhb(2)) / Sin(fhb(3))
    
End Function
Private Sub Cmd1_Click()
   '正算测试程序
   Dim qxxy(100, 8) As Double
   Dim xsz(100, 3) As Double
      
   '线元要素表存入数组qxxy中，切线方位角以弧度为单位
   '可采用读文本文件、Excel数据表中的数据或其它方式读入数据替代以下直接赋值方式
   qxxy(1, 1) = 500: qxxy(1, 2) = 19942.837: qxxy(1, 3) = 28343.561: qxxy(1, 4) = 2.186466069
   qxxy(1, 5) = 269.256: qxxy(1, 6) = 1E+45: qxxy(1, 7) = 1E+45: qxxy(1, 8) = 0
  
   qxxy(2, 1) = 769.256: qxxy(2, 2) = 19787.34: qxxy(2, 3) = 28563.378: qxxy(2, 4) = 2.186466069
   qxxy(2, 5) = 37.492: qxxy(2, 6) = 1E+45: qxxy(2, 7) = 221.75: qxxy(2, 8) = -1
  
   qxxy(3, 1) = 806.748: qxxy(3, 2) = 19766.566: qxxy(3, 3) = 28594.574: qxxy(3, 4) = 2.101929446
   qxxy(3, 5) = 112.779:  qxxy(3, 6) = 221.75: qxxy(3, 7) = 221.75: qxxy(3, 8) = -1
  
   qxxy(4, 1) = 919.527: qxxy(4, 2) = 19736.072: qxxy(4, 3) = 28701.893: qxxy(4, 4) = 1.593343217
   qxxy(4, 5) = 80.285: qxxy(4, 6) = 221.75: qxxy(4, 7) = 9579.228: qxxy(4, 8) = -1
  
   qxxy(5, 1) = 999.812: qxxy(5, 2) = 19744.038: qxxy(5, 3) = 28781.659: qxxy(5, 4) = 1.408141337
   qxxy(5, 5) = 100#: qxxy(5, 6) = 1E+45: qxxy(5, 7) = 1E+45: qxxy(5, 8) = 0
  
   '将要计算坐标的里程桩号及距中线距离存入数组xsz中
   xsz(1, 1) = 700: xsz(1, 2) = -5
   xsz(2, 1) = 700: xsz(2, 2) = 0
   xsz(3, 1) = 700: xsz(3, 2) = 5
  
   xsz(4, 1) = 780: xsz(4, 2) = -5
   xsz(5, 1) = 780: xsz(5, 2) = 0
   xsz(6, 1) = 780: xsz(6, 2) = 5
  
   xsz(7, 1) = 870: xsz(7, 2) = -5
   xsz(8, 1) = 870: xsz(8, 2) = 0
   xsz(9, 1) = 870: xsz(9, 2) = 5
  
   xsz(10, 1) = 940: xsz(10, 2) = -5.123
   xsz(11, 1) = 940: xsz(11, 2) = 0
   xsz(12, 1) = 940: xsz(12, 2) = 3.009

   Dim i As Integer
   Dim j As Integer
   Dim k As Integer
   Dim ysb(8) As Double
   Dim wzb(3) As Double
   Dim jgb(3) As Double
  
   Txt1.Text = ""
   For i = 1 To 12
       For j = 1 To 5
           If qxxy(j, 1) <= xsz(i, 1) And xsz(i, 1) <= qxxy(j, 1) + qxxy(j, 5) Then
              For k = 1 To 8: ysb(k) = qxxy(j, k): Next k
              For k = 1 To 2: wzb(k) = xsz(i, k): Next k
              '调用正算函数
              Call qxzs(ysb(), wzb(), jgb())
              Txt1.Text = Txt1.Text + Str(wzb(1)) + "  " + Str(wzb(2)) + Chr(13) + Chr(10)
              For k = 1 To 3
                 Txt1.Text = Txt1.Text + Str(jgb(k)) + Chr(13) + Chr(10)
              Next k
              Txt1.Text = Txt1.Text + Chr(13) + Chr(10)

上一页  [1] [2] [3]  下一页

上一篇：计算区域面积[VB/VBA函数]