[奉献]几个自定义三角函数
短短几个函数,可能会帮上你的大忙,本人特别推荐Atan函数,可以求出四象限任意角度的反正切.这是我多年的编程浓缩,请斑竹鼓励鼓励
Public Function Rtd(R)
Rem 弧转度,By Sdh,2005-6-4
Rtd = R * 45# / Atn(1)
End Function
Public Function Dtr(D)
Rem 度转弧,By Sdh,2005-6-4
Dtr = D * Atn(1) / 45#
End Function
Public Function Atan(NumberY, NumberX)
Rem 反正切函数(扩充),By Sdh,2005-3-25
Rem 结果范围 (-PI,PI]
Dim Result As Double
If NumberY = 0 And NumberX = 0 Then Exit Function
If Abs(NumberY) <= Abs(NumberX) Then
Result = Abs(Atn(NumberY / NumberX))
Else
Result = 2 * Atn(1) - Abs(Atn(NumberX / NumberY))
End If
If NumberX < 0 Then Result = 4 * Atn(1) - Result
If NumberY < 0 Then Result = -Result
Atan = Result
End Function
Public Function ASin(Number)
Rem 反正弦函数,By Sdh,2005-3-25
ASin = Atan(Number, Sqr(-Number * Number + 1))
End Function
Public Function ACos(Number)
Rem 反余弦函数,By Sdh,2005-2-4
ACos = Atan(-Number, Sqr(-Number * Number + 1)) + 2 * Atn(1)
End Function
Re:[奉献]几个自定义三角函数
这些是用visualbasic写的吧？ vb没有这些函数吗？Re:[奉献]几个自定义三角函数
VB没有,自己扩充的Re:[奉献]几个自定义三角函数
vb的确没有，顶一下，sdh142857很热心，如果大家都这样，这个版很有希望哦Re:[奉献]几个自定义三角函数
多谢斑竹鼓励,我会加油的!Re:[奉献]几个自定义三角函数
继续分享我的平面几何函数,这绝对是我的原创,希望有更多VB编程爱好者加入本论坛Private Const MIN_LENGTH = 0.000000001
Public Function EqualPoint(P1, P2) As Boolean
Rem 点是否相等,By Sdh 2005-3-2
EqualPoint = (Sqr((P2(0) - P1(0)) ^ 2 + (P2(1) - P1(1)) ^ 2) <= MIN_LENGTH)
End Function
Public Function Dist(P1, P2) As Double
Rem 1. 距离计算(两点),By Sdh,2005-4-20
Dist = Sqr((P2(0) - P1(0)) ^ 2 + (P2(1) - P1(1)) ^ 2)
End Function
Public Function Angle(P1, P2, Optional P3, Optional P4, Optional Mode As Integer) As Double
Rem 2. 角度计算(2-4点),By Sdh,2005-4-20
Dim A1#, A2#, B1#, B2#, RetAngle As Double
A1 = P2(1) - P1(1): B1 = P1(0) - P2(0)
If IsMissing(P3) Then
RetAngle = MyMath.Atan(A1, -B1)
Else
If IsMissing(P4) Then
A2 = P3(1) - P2(1): B2 = P2(0) - P3(0)
Else
A2 = P4(1) - P3(1): B2 = P3(0) - P4(0)
End If
RetAngle = MyMath.Atan(A1 * B2 - A2 * B1, A1 * A2 + B1 * B2)
End If
Angle = RetAngle
If (RetAngle < 0 And Mode > 0) Then Angle = RetAngle + 8# * Atn(1)
If (RetAngle > 0 And Mode < 0) Then Angle = RetAngle - 8# * Atn(1)
End Function
Public Function P_PXY(Pr, Pt, dX, dY) As Long
Rem 3. 相对坐标,By Sdh,2005-3-2
Pr(0) = Pt(0) + dX
Pr(1) = Pt(1) + dY
End Function
Public Function P_PLR(Pr, Pt, Angle, Radius) As Long
Rem 4. 相对极坐标,By Sdh,2005-3-2
Pr(0) = Pt(0) + Radius * Cos(Angle)
Pr(1) = Pt(1) + Radius * Sin(Angle)
End Function
Public Function Y_PLI(Pc, P1, P2) As Double
Rem 5. 求点到线的距离(+/-),By Sdh,2005-6-4,Tst 2005-6-5
Rem 提供点Pc，起点P1，终点P2,返回距离Yr,求解成功函数返回0
Dim A1#, B1#, C1#, Dn#, Yr#
A1 = P2(1) - P1(1): B1 = P1(0) - P2(0): C1 = P2(0) * P1(1) - P1(0) * P2(1)
Dn = A1 * A1 + B1 * B1
If Dn = 0 Then '*非线*
Yr = Sqr((Pc(0) - P1(0)) ^ 2 + (Pc(1) - P1(1)) ^ 2)
Else
Yr = -(A1 * Pc(0) + B1 * Pc(1) + C1) / Sqr(Dn)
End If
Y_PLI = Yr
End Function
Public Function X_PLI(Pc, P1, P2) As Double
Rem 6. 求点到线的投影(+/-),By Sdh,2005-6-4,Tst 2005-6-5
Rem 提供点Pc，起点P1，终点P2,返回距离Xr,求解成功函数返回0
Dim A1#, B1#, C1#, Dn#, Xr#
A1 = P2(1) - P1(1): B1 = P1(0) - P2(0): C1 = P2(0) * P1(1) - P1(0) * P2(1)
Dn = A1 * A1 + B1 * B1
If Dn = 0 Then '*非线*
Xr = 0
Else
Xr = (A1 * (Pc(1) - P1(1)) + B1 * (P1(0) - Pc(0))) / Sqr(Dn)
End If
X_PLI = Xr
End Function
Public Function P_PLI(Pr, Pc, P1, P2) As Long
Rem 7. 求点到线的垂足,By Sdh,2005-3-3,Tst 2005-6-5
Rem 提供点Pc，起点P1，终点P2,返回交点,若有交函数返回点为0,重合为2,否则为-1
Dim A1#, B1#, C1#, Dn#
A1 = P2(1) - P1(1): B1 = P1(0) - P2(0): C1 = P2(0) * P1(1) - P1(0) * P2(1)
Dn = A1 * A1 + B1 * B1
If Dn = 0 Then P_PLI = -1: Exit Function '平行,无交点
Pr(0) = -(C1 * A1 - (B1 * Pc(0) - A1 * Pc(1)) * B1) / Dn
Pr(1) = -(A1 * (B1 * Pc(0) - A1 * Pc(1)) + B1 * C1) / Dn
End Function
Public Function P_LLI(Pr, P1, P2, P3, P4) As Long
Rem 8. 求线线交点,By Sdh,2005-3-4,Tst 2005-6-4
Rem 起点P1，终点P2,起点P3，终点P4,返回交点,若有交函数返回点为0,重合为2,否则为-1
Dim A1#, B1#, C1#, A2#, B2#, C2#, Dn#
A1 = P2(1) - P1(1): B1 = P1(0) - P2(0): C1 = P2(0) * P1(1) - P1(0) * P2(1)
A2 = P4(1) - P3(1): B2 = P3(0) - P4(0): C2 = P4(0) * P3(1) - P3(0) * P4(1)
Dn = A1 * B2 - A2 * B1
If Dn = 0 Then P_LLI = -1: Exit Function '平行,无交点
Pr(0) = -(C1 * B2 - C2 * B1) / Dn
Pr(1) = -(A1 * C2 - A2 * C1) / Dn
End Function
Public Function P_CCI(Pr1, Pr2, P1, R1, P2, R2) As Long
Rem 9. 求圆圆交点,返回交点Pr1,Pr2,By Sdh,2005-3-4,Tst 2005-6-4
Rem 提供圆心C1，半径R1;圆心C2，半径R2,返回交点Pnt,若有交函数返回点为0,重合为2,否则为-1
Dim A1#, B1#, C1#, Dn#, Yr#, Xr#, Sn%, dX#, dY#
A1 = P2(0) - P1(0): B1 = P2(1) - P1(1)
C1 = ((P1(0) ^ 2 + P1(1) ^ 2 - R1 ^ 2) - (P2(0) ^ 2 + P2(1) ^ 2 - R2 ^ 2)) / 2#
Dn = A1 * A1 + B1 * B1
If Dn = 0 Then P_CCI = -1: Exit Function'*非线*
Xr = -(A1 * P1(0) + B1 * P1(1) + C1) / Sqr(Dn)
If R1 < Abs(Xr) Then P_CCI = -1: Exit Function'*不交*
Yr = Sqr(R1 * R1 - Xr * Xr)
dX = -B1 / Sqr(Dn): dY = A1 / Sqr(Dn)
Pr1(0) = P1(0) + Xr * dY + Yr * dX
Pr1(1) = P1(1) - Xr * dX + Yr * dY
Pr2(0) = P1(0) + Xr * dY - Yr * dX
Pr2(1) = P1(1) - Xr * dX - Yr * dY
End Function
Public Function P_CLI(Pr1, Pr2, Pc, Rc, P1, P2) As Long
Rem 10. 求圆线交点,返回交点Pr1,Pr2,By Sdh,2005-6-4,Tst 2005-6-4
Rem 提供圆心Pc，半径Rc;起点P1，终点P2,若有交函数返回点为0,重合为2,否则为-1
Dim A1#, B1#, C1#, Dn#, Yr#, Xr#, dX#, dY#
A1 = P2(1) - P1(1): B1 = P1(0) - P2(0): C1 = P2(0) * P1(1) - P1(0) * P2(1)
Dn = A1 * A1 + B1 * B1
If Dn = 0 Then P_CLI = -1: Exit Function'*非线*
Xr = -(A1 * Pc(0) + B1 * Pc(1) + C1) / Sqr(Dn)
If Rc < Abs(Xr) Then P_CLI = -1: Exit Function'*不交*
Yr = Sqr(Rc * Rc - Xr * Xr)
dX = -B1 / Sqr(Dn): dY = A1 / Sqr(Dn)
Pr1(0) = Pc(0) + Xr * dY + Yr * dX
Pr1(1) = Pc(1) - Xr * dX + Yr * dY
Pr2(0) = Pc(0) + Xr * dY - Yr * dX
Pr2(1) = Pc(1) - Xr * dX - Yr * dY
End Function
Re:[奉献]几个自定义三角函数
sdh142857去申请版主吧。
页:
[1]