|
3#
楼主 |
发表于 2012-12-13 10:12:34
|
只看该作者
'*************************************************************
' 函数名:Line3DSet0
' 功能: 求拟合空间直线(相关参数)
' 参数: dataRaw - tagPoint型 自定义点类型(x,y,z),数组
' nLine - tagLine3D 其值返回为直线相关参数
' 返回值:Long型,失败为0,成功为-1
'*************************************************************
Function Line3DSet0(dataRaw() As tagPoint, nLine As tagLine3D) As Long
'3D line's formula is showing as following.
'1)|Ax +By +Z+D =0
' |A1x+B1y+z+D1=0
'2)(x-x0)/m=(y-y0)/n=(z-z0)/p
'3)x=mt+x0,y=nt+y0,z=pt+z0
'Only point's coordinate is (a+b*Z, c+d*Z,Z),so the line's vector is {b,d,1}
Dim SumX, SumY, SumZ, SumXZ, SumYZ, SumZ2
Dim TolN As Long, i As Long, j As Long, lb As Long, ub As Long
Dim d, d1, d2
Dim VecLine As tagVector
Dim xLine As tagVector '{1,0,0}
Dim yLine As tagVector '{0,1,0}
Dim zLine As tagVector '{0,0,1}
Dim maxS As Double, minS As Double, tmpD As Double
xLine.a = 1: xLine.b = 0: xLine.c = 0
yLine.a = 0: yLine.b = 1: yLine.c = 0
zLine.a = 0: zLine.b = 0: zLine.c = 1
'Dim AvgX As Double, AvgY As Double
lb = LBound(dataRaw): ub = UBound(dataRaw)
If ub < 2 Then
Line3DSet0 = 0
Exit Function
End If
TolN = ub - lb + 1
For i = lb To ub
With dataRaw(i)
SumX = SumX + .x
SumY = SumY + .y
SumZ = SumZ + .z
SumXZ = SumXZ + .x * .z
SumYZ = SumYZ + .y * .z
SumZ2 = SumZ2 + .z ^ 2
End With
Next i
d = TolN * SumZ2 - SumZ ^ 2
d1 = SumX * SumZ2 - SumZ * SumXZ
d2 = TolN * SumXZ - SumX * SumZ
With nLine
.p = 1
.x0 = d1 / d
.m = d2 / d
d1 = SumY * SumZ2 - SumZ * SumYZ
d2 = TolN * SumYZ - SumY * SumZ
.y0 = d1 / d
.n = d2 / d
.z0 = 0
.x = SumX / TolN
.y = SumY / TolN
.z = SumZ / TolN
VecLine.a = .m: VecLine.b = .n: VecLine.c = 0
.Angle = Intersect(VecLine, xLine) '(xLine.A * SLine.A + xLine.A * SLine.B + xLine.C * SLine.C)
If VecLine.b < 0 Then .Angle = 360 - .Angle
VecLine.a = .m: VecLine.b = .n: VecLine.c = .p
.xAn = Intersect(VecLine, xLine)
.yAn = Intersect(VecLine, yLine)
.zAn = Intersect(VecLine, zLine)
For i = lb To ub
Call PointToLine(dataRaw(i), nLine, tmpD)
If i = lb Then
maxS = tmpD
minS = tmpD
Else
If tmpD > maxS Then maxS = tmpD
If tmpD < minS Then minS = tmpD
End If
'Cells(i + 1, 15) = tmpD
Next i
.MaxSt = maxS
.MinSt = minS
.Straightness = 2 * maxS
End With
Line3DSet0 = -1
End Function
'*************************************************************
' 函数名:Line3DSet
' 功能: 求拟合空间直线(相关参数)
' 参数: dataRaw - tagPoint型 自定义点类型(x,y,z),数组
' nLine - tagLine3D 其值返回为直线相关参数
' 返回值:Long型,失败为0,成功为-1
'*************************************************************
Public Function Line3DSet(dataRaw() As tagPoint, nLine As tagLine3D) As Long
'3D line's formula is showing as following.
'1)|Ax +By +Z+D =0
' |A1x+B1y+z+D1=0
'2)(x-x0)/m=(y-y0)/n=(z-z0)/p
'3)x=mt+x0,y=nt+y0,z=pt+z0
'Only point's coordinate is (a+b*Z, c+d*Z,Z),so the line's vector is {b,d,1}
Dim TolN As Long, i As Long, j As Long, lb As Long, ub As Long
Dim VecLine As tagVector
Dim xLine As tagVector '{1,0,0}
Dim yLine As tagVector '{0,1,0}
Dim zLine As tagVector '{0,0,1}
Dim maxS As Double, minS As Double, tmpD As Double
Dim a(1, 1) As Double, b(1, 1) As Double, c(1, 1) As Double
xLine.a = 1: xLine.b = 0: xLine.c = 0
yLine.a = 0: yLine.b = 1: yLine.c = 0
zLine.a = 0: zLine.b = 0: zLine.c = 1
Dim SumXZ, SumX, SumYZ, SumY, SumZ2, SumZ
lb = LBound(dataRaw): ub = UBound(dataRaw)
TolN = ub - lb + 1
If ub < 2 Then
Line3DSet = 0
Exit Function
End If
For i = lb To ub
With dataRaw(i)
SumXZ = SumXZ + .x * .z
SumYZ = SumYZ + .y * .z
SumX = SumX + .x
SumY = SumY + .y
SumZ = SumZ + .z
SumZ2 = SumZ2 + .z ^ 2
End With
Next i
a(0, 0) = SumXZ: a(0, 1) = SumX: a(1, 0) = SumYZ: a(1, 1) = SumY
c(0, 0) = SumZ2: c(0, 1) = SumZ: c(1, 0) = SumZ: c(1, 1) = TolN
Call sMInverse(b, c) ' to inverse matrix
Call sMMult(c, a, b) 'to multiple two matrix
'{m,x0}
'{n,y0}
With nLine
.m = c(0, 0)
.n = c(1, 0)
.x0 = c(0, 1)
.y0 = c(1, 1)
.z0 = 0
.p = 1
.x = SumX / TolN
.y = SumY / TolN
.z = SumZ / TolN
VecLine.a = .m: VecLine.b = .n: VecLine.c = 0
.Angle = Intersect(VecLine, xLine) '(xLine.A * SLine.A + xLine.A * SLine.B + xLine.C * SLine.C)
If VecLine.b < 0 Then .Angle = 360 - .Angle
VecLine.a = .m: VecLine.b = .n: VecLine.c = .p
.xAn = Intersect(VecLine, xLine)
.yAn = Intersect(VecLine, yLine)
.zAn = Intersect(VecLine, zLine)
For i = lb To ub
Call PointToLine(dataRaw(i), nLine, tmpD)
If i = lb Then
maxS = tmpD
minS = tmpD
Else
If tmpD > maxS Then maxS = tmpD
If tmpD < minS Then minS = tmpD
End If
' Cells(i + 1, 15) = tmpD
Next i
.MaxSt = maxS
.MinSt = minS
.Straightness = 2 * maxS
Line3DSet = -1
Debug.Print "Totol Number", TolN
Debug.Print ".x: ", .x
Debug.Print ".y: ", .y
Debug.Print ".z: ", .z
Debug.Print ".x0: ", .x0
Debug.Print ".y0: ", .y0
Debug.Print ".m: ", .m
Debug.Print ".n: ", .n
Debug.Print ".p: ", .p
Debug.Print ".Angle: ", .Angle
Debug.Print ".xAn: ", .xAn
Debug.Print ".yAn: ", .yAn
Debug.Print ".zAn: ", .zAn
Debug.Print "Straightness", .Straightness, .MaxSt, .MinSt
End With
End Function
|
|