[VBA函数]：曲线任意里程中边桩坐标正反算(VB6.0或VBA)函数

yshf

曲线任意里程中边桩坐标正反算(VB6.0或VBA)函数
'本文的两个函数是根据“曲线任意里程中边桩坐标正反算(CASIO　FX—4800P计算器) '程序”
'移植而成。
'一、约定
       ' (1) 以道路中线的前进方向（即里程增大的方向）区分左右；当线元往左偏时，
'线元偏向标志=-1；当线元往右偏时，线元偏向标志=1；当线元为直线时，线元偏向标志=0。
        '(2) 当所求点位于中线时，边距=0；当位于中线左铡时，边距取负值；当位于中线中线右
'侧时，边距取正值。
       ' (3) 当线元为直线时，其起点、止点的曲率半径为无穷大，以10的45次代替。
        '(4) 当线元为圆曲线时，无论其起点、止点与什么线元相接，其曲率半径均等于圆
'弧的半径。
         '(5) 当线元为完整缓和曲线时，起点与直线相接时，曲率半径为无穷大，以10的45
'次代替；与圆曲线相接时，曲率半径等于圆曲线的半径。止点与直线相接时，曲率半
'径为无穷大，以10的45次代替；与圆曲线相接时，曲率半径等于圆曲线的半径。
         '(6) 当线元为非完整缓和曲线时，起点与直线相接时，曲率半径等于设计规定的
'值；与圆曲线相接时，曲率半径等于圆曲线的半径。止点与直线相接时，曲率半径等
'于设计规定的值；与圆曲线相接时，曲率半径等于圆曲线的半径。
'二、功能
'可以根据曲线段——直线、圆曲线、缓和曲线（完整或非完整型）的线元要素（起点里程、起元点
'坐标、起点切线方位角、线元长度、起点曲率半径、止点曲率半径、线元偏向标志）及里程边距或
'坐标，对该曲线段范围内任意里程中边桩坐标进行正反算。
'三、源程序
Private Const pi As Double = 3.14159265358979
Public Function qxzs(xyb() As Double, sz() As Double, fhz() As Double)
'正算函数(由里程和边距计算坐标)
'入口参数线元要素xyb()及sz()为:
'xyb(1)=线元起点里程  xyb(2)=线元起点X坐标 xyb(3)=线元起点Y坐标 xyb(4)=线元起点切线方位角(以弧度为单位)
'xyb(5)=线元长度  xyb(6)=线元起点曲率半径 xyb(7)=线元止点曲率半径 xyb(8)=线元偏向标志
'sz(1)=要计算点的中线里程 sz(2)=要计算点距中线的边距
'返回值fhz()为：
'fhz(1)=所求点的X坐标 fhz(2)=所求点的Y坐标 fhz(3)=所求点的法线方位角
   Dim f0 As Double
   Dim q As Double
   Dim c As Double
   Dim d As Double
   Dim rr(4) As Double
   Dim vv(4) As Double
   Dim i As Integer
   Dim w As Double
   Dim xs As Double
   Dim ys As Double
   Dim ff As Double
   
   f0 = xyb(4): q = xyb(8)
   c = 1# / xyb(6)
   d = (xyb(6) - xyb(7)) / 2# / xyb(5) / xyb(6) / xyb(7)
   rr(1) = 0.1739274226: rr(2) = 0.3260725774
   rr(3) = rr(2): rr(4) = rr(1)
   vv(1) = 0.0694318442: vv(2) = 0.3300094782
   vv(3) = 1# - vv(2): vv(4) = 1# - vv(1)
   w = Abs(sz(1) - xyb(1))
   
   xs = 0: ys = 0
   For i = 1 To 4
       ff = f0 + q * vv(i) * w * (c + vv(i) * w * d)
       xs = xs + rr(i) * Cos(ff)
       ys = ys + rr(i) * Sin(ff)
   Next i
   
   fhz(3) = f0 + q * w * (c + w * d) + 0.5 * pi
   fhz(1) = xyb(2) + w * xs + sz(2) * Cos(fhz(3))
   fhz(2) = xyb(3) + w * ys + sz(2) * Sin(fhz(3))
     
End Function

Public Function qxfs(xyb() As Double, xpt() As Double, fhb() As Double)
'反算函数(由坐标计算里程和边距)
'入口参数线元要素xyb()及xpt()为:
'xyb(1)=线元起点里程  xyb(2)=线元起点X坐标 xyb(3)=线元起点Y坐标 xyb(4)=线元起点切线方位角(以弧度为单位)
'xyb(5)=线元长度  xyb(6)=线元起点曲率半径 xyb(7)=线元止点曲率半径 xyb(8)=线元偏向标志
'xpt(1)=要计算点的X坐标 xpt(2)=要计算点的Y坐标
'返回值fhb()为：
'fhb(1)=所求点的中线里程 fhb(2)=所求点距中线的边距
   Dim f0 As Double
   Dim q As Double
   Dim c As Double
   Dim d As Double
   Dim rr(4) As Double
   Dim vv(4) As Double
   Dim i As Integer
   Dim w As Double
   Dim xs As Double
   Dim ys As Double
   Dim ff As Double
   Dim z As Double
   Dim sz(2) As Double
   
   f0 = xyb(4): q = xyb(8)
   c = 1# / xyb(6)
   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
   
   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

hsb-hy

请楼主指导一下，这个程序怎么使用，在计算机上要安装哪些程序？能否做成可执行文件？

yshf

需要安装Vsual Basic 6.0（VB6.0）或Auto CAD 2000发上的版本。它是VB6.0或Auto CAD 2000 VBA环境中的两个函数，请自己添置取得线元要素、进行正反算的窗体。

qjcpj

1楼楼主应在VBA板块发贴！

huj81

我看不懂，看样子还好好学哈！

luob72

我也看不懂，太高深了，要好好学习了啊

xqs001

同志啊,你可以把他封撞起来么,怎么用也没有人知道,大伙好象对函数不怎么精通啊