求助VBA自定义函数：求空间某一个点距离它最近的一条直线

钟庆泉　发表于：2016-08-26 17:02:15 　

本人初学VBA，求助偏个小程序如题：

平面中某点（x,y)，分别计算其到直线D1：X+Y-1=0，直线D2：X+Y+2=0的距离

然后找出两者中的距离最小的直线。

谢谢！

试编如下：

Private Sub X_AfterUpdate()
Me.最近线 = CC(Me.X, Me.Y)
End Sub

Function CC(X As Double, Y As Double) As String
Dim D1, D2
D1 = Abs(X + Y - 1) / Sqr(1 ^ 2 + 1 ^ 2) '计算D1、D2距离，D1\D2是直线的代码
D2 = Abs(X + Y + 2) / Sqr(1 ^ 2 + 1 ^ 2)
CC= Min(D1, D2) '取最小值所对应的代码，结果要输出代码D1或D2，不要具体数值
End Function

Top

钟庆泉发表于：2016-08-26 17:07:42

min()函数VBA居然无法识别

求解

Top

煮江品茶发表于：2016-08-28 10:55:51

vba中没有Min函数吧？可以写一个自定义求最小值得函数。

Function myMin(ByVal x As Double, ByVal y As Double) As Double
    Dim min As Double
    min = x
    If y < x Then min = y
    myMin = min
End Function

Top

钟庆泉发表于：2016-08-29 14:01:17

谢谢，楼上的回复。

但我的问题是，如果要求的最小值不是2个数，而是多个数时，如何处理？

且我想要的是最小值对应的直线代码，不是最小的数值是多少.我改了一下，看这样代表是不是更容易理解

Private Sub X_AfterUpdate()
Me.最近线 = CC(Me.X, Me.Y)
End Sub

Function CC(X As Double, Y As Double) As String
Dim A, B, C As String
Dim a1, b1, c1, min As Double
Dim arr() As Variant
arr = [{"A","a1";"B","b1";"C","c1"}]
a1 = Abs(X + Y - 1) / Sqr(1 ^ 2 + 1 ^ 2) '计算A、B、C距离a1\b1\c1
b1 = Abs(X + Y + 2) / Sqr(1 ^ 2 + 1 ^ 2)
c1 = Abs(X + Y + 5) / Sqr(1 ^ 2 + 1 ^ 2)
min = DMin(a1, b1, c1) '取最小值所对应的代码，结果要输出A、B、C，不要具体数值
CC=dlookup( '对应代码是.....不会写了
End Function

Top

zhaoyoulong 发表于：2016-08-29 17:25:17

Function MyMin(MyArray() As Variant)
Dim i As Integer
Dim currentVal As Variant
currentVal = MyArray(0)
For i = 0 To UBound(MyArray)
If FieldArray(i) < currentVal Then
currentVal =MyArray(i)
End If
Next i
MyMin= currentVal
End Function

Top

钟庆泉发表于：2016-08-30 21:02:40

谢谢两的回复，给我很大的提示，问题得以解决

Top

总记录：5篇页次：1/1 9 1 :

Access交流中心

求助VBA自定义函数：求空间某一个点距离它最近的一条直线