CATIA V5 Macro - Useful Functions

CATIA V5 Macro - Useful Functions

Please read Liability Disclaimer and License Agreement CAREFULLY

Unlock the full potential of Catia V5 with my comprehensive collection of useful VBA functions.

This web page provides a comprehensive set of helper functions for Catia V5, including functions to get point coordinates, normalize vectors, get plane equations and vectors, and determine the distance between two points.

Other functions allow you to determine whether two points are on the same side of a plane, get the vector of a line, and find the BrepName from a Catia Selection.

Additionally, you can use this web page to determine whether two lines are skew, intersecting or parallel, and to calculate the distance between two skew lines.

You can also calculate the DOT and CROSS products of two vectors, and obtain the inverse and determinant of an N x N matrix, as well as the Adjoint and Minor matrices.

For designers looking to work with curves, the page includes functions to approximate a curve using Cubic or Quadratic Bezier, and to sort vectors.

Other functions allow you to get the direction vector of a line, the normal vector of a plane containing two lines, and the distance between two lines.

The functions are designed to streamline your workflow and increase your productivity, allowing you to take your Catia V5 designs to the next level.

Read further to learn more and revolutionize your Catia V5 experience.

 

Create a Module in your project and paste the code below, name it Q

Public Type iPct
	X As Double
	Y As Double
	Z As Double
End Type

Public Type iPlan
	Ax As Double
	By As Double
	Cz As Double
	Dt As Double
End Type

Public Enum iIntVal
	Intersectie = 0  'Intersection
	Paralele = 1
	Oblice = 2  'Skew
End Enum

Public Type iIntersect
	Result As iIntVal
	Val As iPct
End Type

Create a new module and name it as you like, just paste the code below in it

Sub CATMain()
    'From Star Treck :)
    Dim Q As New clsGVI
    Dim A As iPct
    Dim B As iPct
    Dim C As iPct
    Dim D As iPct
    'Point A and B are on one line
    'Point C and D are on second line
    A.X = 1: A.Y = 1: A.Z = 1
    B.X = 3: B.Y = 3: B.Z = 1
    C.X = 0: C.Y = 1: C.Z = 4
    D.X = 0: D.Y = 3: D.Z = 3
    Dim dist As Double
    dist = Q.LineToLineDistance(A, B, C, D)
    Debug.Print "The minimum distance between the two lines is " & dist
End Sub

Create a Class Module in the same project and rename it to clsGVI and paste the code below

Const PI As Double = 3.14159265358979

Catia V5 VBA function to get point coordinates

Public Function GetPointXYZ(MyPoint As Variant) As iPct
	Dim Coord(2): Set GetPointXYZ = New iPct
	MyPoint.GetCoordinates Coord
	GetPointXYZ.X = Coord(0): GetPointXYZ.Y = Coord(1): GetPointXYZ.Z = Coord(2)
	Erase Coord
End Function

Catia V5 VBA function to get point coordinates relative to an specified axis system

Public Function LCS(AxisSys As Variant, Point2Measure As iPct) As iPct
	Dim AOrig(2): Dim Vx(2): Dim Vy(2): Dim Vz(2)
	Dim iOrig As iPct: Dim iVx As iPct: Dim iVy As iPct: Dim iVz As iPct: Dim Diff As iPct
	Set LCS = New iPct
	AxisSys.GetOrigin AOrig: iOrig.X = AOrig(0): iOrig.Y = AOrig(1): iOrig.Z = AOrig(2)
	AxisSys.GetXAxis Vx: iVx.X = Vx(0): iVx.Y = Vx(1): iVx.Z = Vx(2)
	AxisSys.GetYAxis Vy: iVy.X = Vy(0): iVy.Y = Vy(1): iVy.Z = Vy(2)
	AxisSys.GetZAxis Vz: iVz.X = Vz(0): iVz.Y = Vz(1): iVz.Z = Vz(2)
	NormalizeVector iVx, iVx
	NormalizeVector iVy, iVy
	NormalizeVector iVz, iVz
	Diff.X = Point2Measure.X - iOrig.X: Diff.Y = Point2Measure.Y - iOrig.Y: Diff.Z = Point2Measure.Z - iOrig.Z
	LCS.X = DotProduct(Diff, iVx): LCS.Y = DotProduct(Diff, iVy): LCS.Z = DotProduct(Diff, iVz)
	Set iOrig = Nothing: Set iVx = Nothing: Set iVy = Nothing: Set iVz = Nothing: Set Diff = Nothing
	Erase AOrig: Erase Vx: Erase Vy: Erase Vz
End Function

Catia V5 VBA procedure to Normalize of a vector

Public Sub NormalizeVector(IVect As iPct, ByRef NVect As iPct)
	Dim Mag As Double
	Mag = Sqr(IVect.X ^ 2 + IVect.Y ^ 2 + IVect.Z ^ 2)
	If Mag < 0.0000001 Then Call Err.Raise(1001, , "Zero length vector cannot be normalized")
	NVect.X = IVect.X / Mag
	NVect.Y = IVect.Y / Mag
	NVect.Z = IVect.Z / Mag
End Sub

Catia V5 VBA function to get Plane Equation

Public Function PlaneEquation(PartOrigin As iPct, PlaneOrigin As iPct, FirstVector As iPct, SecondVector As iPct) As iPlan
    Set PlaneEquation = New iPlan
    PlaneEquation.Ax = PartOrigin.Y * (FirstVector.Z - SecondVector.Z) + FirstVector.Y * (SecondVector.Z - PartOrigin.Z) + SecondVector.Y * (PartOrigin.Z - FirstVector.Z)
    PlaneEquation.By = PartOrigin.Z * (FirstVector.X - SecondVector.X) + FirstVector.Z * (SecondVector.X - PartOrigin.X) + SecondVector.Z * (PartOrigin.X - FirstVector.X)
    PlaneEquation.Cz = PartOrigin.X * (FirstVector.Y - SecondVector.Y) + FirstVector.X * (SecondVector.Y - PartOrigin.Y) + SecondVector.X * (PartOrigin.Y - FirstVector.Y)
    PlaneEquation.Dt = PlaneOrigin.X * (FirstVector.Y * SecondVector.Z - SecondVector.Y * FirstVector.Z) + FirstVector.X * (SecondVector.Y * PlaneOrigin.Z - PlaneOrigin.Y * _
    SecondVector.Z) + SecondVector.X * (PlaneOrigin.Y * FirstVector.Z - FirstVector.Y * PlaneOrigin.Z)
End Function

Catia V5 VBA function to get plane vectors

Public Function GetPlaneVectors(MyPlane As Variant) As iPct()
	Dim ArrRet() As iPct: ReDim ArrRet(1)
	Dim V1(2): Dim V2(2)
	MyPlane.GetFirstAxis V1: ArrRet(0).X = V1(0): ArrRet(0).Y = V1(1): ArrRet(0).Z = V1(2)
	MyPlane.GetSecondAxis V2: ArrRet(1).X = V2(0): ArrRet(1).Y = V2(1): ArrRet(1).Z = V2(2)
	GetPlaneVectors = ArrRet
	Erase ArrRet: Erase V1: Erase V2
End Function

Catia V5 VBA function to get angle between two planes - Dihedral Angle

Public Function DihedralAngle(FirstPlane As iPlan, SecondPlane As iPlan) As Double
	DihedralAngle = ArcCos(FirstPlane.Ax * SecondPlane.Ax + FirstPlane.By * SecondPlane.By + FirstPlane.Cz * SecondPlane.Cz / _
	Sqr((FirstPlane.Ax ^ 2 + FirstPlane.By ^ 2 + FirstPlane.Cz ^ 2) * (SecondPlane.Ax ^ 2 + SecondPlane.By ^ 2 + SecondPlane.Cz ^ 2)))
End Function

Catia V5 VBA function to get ArcCos

Public Function ArcCos(Radians As Double) As Double
	If Round(Radians, 8) = 1 Then ArcCos = 0: Exit Function
	If Round(Radians, 8) = -1 Then ArcCos = PI: Exit Function
	ArcCos = Atn(-Radians / Sqr(1 - Radians ^ 2)) + 2 * Atn(1)
End Function

Catia V5 VBA function to get ArcSin

Public Function ArcSin(Radians As Double) As Double
	If (Sqr(1 - Radians ^ 2) <= 0.000000000001) And (Sqr(1 - Radians ^ 2) >= -0.000000000001) Then
		ArcSin = PI / 2
	Else
		ArcSin = Atn(Radians / Sqr(1 - Radians ^ 2))
	End If
End Function

Catia V5 VBA function to get distance between two points

Public Function P2PDist(FirstPoint As iPct, SecondPoint As iPct) As Double
	Distance = Sqr((SecondPoint.X - FirstPoint.X) ^ 2 + (SecondPoint.Y - FirstPoint.Y) ^ 2 + (SecondPoint.Z - FirstPoint.Z) ^ 2)
End Function

Catia V5 VBA function to determine if two points on the same side of a plane

Public Function WhichSideOfPlane(Plane As iPlan, FirstPoint As iPct, SecondPoint As iPct) As Integer()
	Dim ArrReturn() As Integer: ReDim ArrReturn(1)
	ArrReturn(0) = Plane.Ax * FirstPoint.X + Plane.By * FirstPoint.Y + Plane.Cz * FirstPoint.Z - Plane.Dt
	ArrReturn(1) = Plane.Ax * SecondPoint.X + Plane.By * SecondPoint.Y + Plane.Cz * SecondPoint.Z - Plane.Dt
	WhichSideOfPlane = ArrReturn
	Erase ArrReturn
End Function

Catia V5 VBA function to get the vector of line

Public Function GetLineVector(FirstPoint As iPct, SecondPoint As iPct) As iPct
	Dim Dist As Double: Set GetLineVector = New iPct
	Dist = P2PDist(FirstPoint, Seconpoint)
	GetLineVector.X = (SecondPoint.X - FirstPoint.X) / Dist
	GetLineVector.Y = (SecondPoint.Y - FirstPoint.Y) / Dist
	GetLineVector.Z = (SecondPoint.Z - FirstPoint.Z) / Dist
End Function

Catia V5 VBA function to get BrepName from Catia Selection

Public Function GetBrep(MyBRepName As String) As String
	MyBRepName = Replace(MyBRepName, "Selection_", "")
	MyBRepName = Left(MyBRepName, InStrRev(MyBRepName, "));"))
	MyBRepName = MyBRepName + ");WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)"
	'");WithTemporaryBody;WithoutBuildError;WithInitialFeatureSupport;MonoFond;MFBRepVersion _CXR14)"
	GetBrep = MyBRepName
End Function

Catia V5 VBA function to determine if two lines are skew, intersecting or parallel

Public Function LLIntersect(A As iPct, B As iPct, C As iPct, D As iPct) As iIntersect
	Dim M(3, 3) As Double
	M(0, 0) = A.X: M(0, 1) = A.Y: M(0, 2) = A.Z: M(0, 3) = 1
	M(1, 0) = B.X: M(1, 1) = B.Y: M(1, 2) = B.Z: M(1, 3) = 1
	M(2, 0) = C.X: M(2, 1) = C.Y: M(2, 2) = C.Z: M(2, 3) = 1
	M(3, 0) = D.X: M(3, 1) = D.Y: M(3, 2) = D.Z: M(3, 3) = 1
	If GetDet(M) <> 0 Then Erase M: LLIntersect.Result = Oblice: Exit Function    'skew lines
	Dim CxB() As Double: Dim AxB() As Double: ReDim CxB(2): ReDim AxB(2)
	Dim Av(2) As Double: Dim Bv(2) As Double: Dim Cv(2) As Double
	Av(0) = B.X - A.X: Av(1) = B.Y - A.Y: Av(2) = B.Z - A.Z
	Bv(0) = D.X - C.X: Bv(1) = D.Y - C.Y: Bv(2) = D.Z - C.Z
	Cv(0) = C.X - A.X: Cv(1) = C.Y - A.Y: Cv(2) = C.Z - A.Z
	CxB = CrossProd(Cv, Bv): AxB = CrossProd(Av, Bv)
	Dim s As Double
	On Error GoTo paralelele
	s = DotProd(CxB, AxB) / Abs(DotProd(AxB, AxB))
	Dim iInter As iPct
	iInter.X = A.X + Av(0) * s    'X coordinate of intersection
	iInter.Y = A.Y + Av(1) * s    'Y coordinate of intersection
	iInter.Z = A.Z + Av(2) * s    'Z coordinate of intersection
	LLIntersect.Result = Intersectie    'intersecting lines
	LLIntersect.Val = iInter
	paralelele:
	Erase CxB: Erase AxB: Erase Cv: Erase Bv: Erase Av
	If Err.Number <> 0 Then LLIntersect.Result = PParalele: Err.Clear    'parallel lines
End Function

Catia V5 VBA function to get the distance between two skew lines

Public Function SkewLDist(A As iPct, B As iPct, C As iPct, D As iPct) As Double
	Dim Av(2) As Double: Dim Bv(2) As Double: Dim Cv(2) As Double
	Dim Det(2, 2) As Double
	Av(0) = A.X - B.X: Av(1) = A.Y - B.Y: Av(2) = A.Z - B.Z
	Bv(0) = C.X - A.X: Bv(1) = C.Y - A.Y: Bv(2) = C.Z - A.Z
	Cv(0) = D.X - C.X: Cv(1) = D.Y - C.Y: Cv(2) = D.Z - C.Z
	Det(0, 0) = DotProd(Cv, Cv): Det(0, 1) = DotProd(Cv, Av): Det(0, 2) = DotProd(Cv, Bv)
	Det(1, 0) = DotProd(Cv, Av): Det(1, 1) = DotProd(Av, Av): Det(1, 2) = DotProd(Av, Bv)
	Det(2, 0) = DotProd(Cv, Bv): Det(2, 1) = DotProd(Av, Bv): Det(2, 2) = DotProd(Bv, Bv)
	Dim v As Double
	v = GetDet(Det)
	SkewLDist = Sqr(v / (Det(0, 0) * Det(1, 1) - Det(1, 0) ^ 2))
End Function

Catia V5 VBA function to get DOT product of two vectors - length must be 3

Public Function DotProd(V1() As Double, V2() As Double) As Double
	DotProd = V1(0) * V2(0) + V1(1) * V2(1) + V1(2) * V2(2)
End Function

Catia V5 VBA function to get CROSS product of two vectors - length must be 3

Public Function CrossProd(V1() As Double, V2() As Double) As Double()
	Dim Res() As Double
	ReDim Res(2)
	Res(0) = V1(1) * V2(2) - V1(2) * V2(1)
	Res(1) = V1(2) * V2(0) - V1(0) * V2(2)
	Res(2) = V1(0) * V2(1) - V1(1) * V2(0)
	CrossProd = Res
	Erase Res
End Function

Catia V5 VBA function to get inverse of an N x N matrix

Public Function GetInverse(M() As Double) As Double()
	Dim RetVal() As Double: Dim Size As Integer
	Dim Det As Double: Dim Adj() As Double
	Dim i As Integer: Dim j As Integer
	Size = UBound(M): Det = GetDet(M)
	If Det <> 0 Then
		ReDim RetVal(Size, Size)
		Adj = GetAdjoint(M)
		For i = 0 To Size
			For j = 0 To Size
				RetVal(i, j) = Adj(i, j) / Det
			Next
		Next
		Erase Adj
		GetInverse = RetVal
		Erase RetVal
	End If
End Function

Catia V5 VBA function to get Determinant of an N x N matrix

Public Function GetDet(M() As Double) As Double
	Dim i As Integer: Dim j As Integer
	Dim Size As Integer: Size = UBound(M): Dim RetVal As Double
	If Size = 1 Then
		RetVal = RetVal + M(0, 0) * M(1, 1) - M(0, 1) * M(1, 0)   'daca e deteminant 2x2
	Else
		For i = 0 To Size
			RetVal = RetVal + ((-1) ^ i) * M(0, i) * GetDet(GetMinor(M, 0, i))    'daca e determinant NxN
		Next
	End If
	GetDet = RetVal
End Function

Catia V5 VBA function to get Adjoint matrix - it is used to calculate inverse of an N x N matrix

Public Function GetAdjoint(M() As Double) As Double()
	Dim i As Integer: Dim j As Integer
	Dim Size As Integer: Size = UBound(M)
	Dim RetVal() As Double: ReDim RV(Size, Size)
	For i = 0 To Size
		For j = 0 To Size
			RetVal(j, i) = ((-1) ^ (i + j)) * GetDet(GetMinor(M, i, j))    'RetVal(i, j)=matricea cofactor; RetVal(j, i)= transpusa matricii cofactor
		Next
	Next
	GetAdjoint = RetVal
	Erase RetVal
End Function

Catia V5 VBA function to get Minor matrix - it is used to calculate the determinant of an N x N matrix

Public Function GetMinor(Min() As Double, RemRow As Integer, RemCol As Integer) As Double()
	Dim RetVal() As Double: Dim i As Integer: Dim j As Integer
	Dim IdxC As Integer: Dim IdxR As Integer
	Dim Size As Integer: IdxR = 0: Size = UBound(Min) - 1
	ReDim RetVal(Size, Size) As Double
	For i = 0 To Size + 1
		If i <> RemRow Then
			IdxC = 0
			For j = 0 To Size + 1
				If j <> RemCol Then
					RetVal(IdxR, IdxC) = Min(i, j)
					IdxC = IdxC + 1
				End If
			Next
			IdxR = IdxR + 1
		End If
	Next
	GetMinor = RetVal
	Erase RetVal
End Function

Catia V5 VBA function to approximate a curve using Cubic Bezier curves

Public Function BSpline3(CollectionOfiPcts As Collection, Increment As Double) As Collection
	Dim i As Double: Dim t As Double
	Dim A As iPlan: Dim B As iPlan: Dim C As iPlan: Dim Point2Add As iPct
	Set BSpline3 = New Collection
	For i = 1 To CollectionOfiPcts.Count - 3
		Set A = New iPlan: Set B = New iPlan: Set C = New iPlan
		A.Ax = (-CollectionOfiPcts(i).X + 3 * CollectionOfiPcts(i + 1).X - 3 * CollectionOfiPcts(i + 2).X + CollectionOfiPcts(i + 3).X) / 6
		A.By = (3 * CollectionOfiPcts(i).X - 6 * CollectionOfiPcts(i + 1).X + 3 * CollectionOfiPcts(i + 2).X) / 6
		A.Cz = (-3 * CollectionOfiPcts(i).X + 3 * CollectionOfiPcts(i + 2).X) / 6
		A.Dt = (CollectionOfiPcts(i).X + 4 * CollectionOfiPcts(i + 1).X + CollectionOfiPcts(i + 2).X) / 6
		B.Ax = (-CollectionOfiPcts(i).Y + 3 * CollectionOfiPcts(i + 1).Y - 3 * CollectionOfiPcts(i + 2).Y + CollectionOfiPcts(i + 3).Y) / 6
		B.By = (3 * CollectionOfiPcts(i).Y - 6 * CollectionOfiPcts(i + 1).Y + 3 * CollectionOfiPcts(i + 2).Y) / 6
		B.Cz = (-3 * CollectionOfiPcts(i).Y + 3 * CollectionOfiPcts(i + 2).Y) / 6
		B.Dt = (CollectionOfiPcts(i).Y + 4 * CollectionOfiPcts(i + 1).Y + CollectionOfiPcts(i + 2).Y) / 6
		C.Ax = (-CollectionOfiPcts(i).Z + 3 * CollectionOfiPcts(i + 1).Z - 3 * CollectionOfiPcts(i + 2).Z + CollectionOfiPcts(i + 3).Z) / 6
		C.By = (3 * CollectionOfiPcts(i).Z - 6 * CollectionOfiPcts(i + 1).Z + 3 * CollectionOfiPcts(i + 2).Z) / 6
		C.Cz = (-3 * CollectionOfiPcts(i).Z + 3 * CollectionOfiPcts(i + 2).Z) / 6
		C.Dt = (CollectionOfiPcts(i).Z + 4 * CollectionOfiPcts(i + 1).Z + CollectionOfiPcts(i + 2).Z) / 6
		For t = 0 To 1 Step Increment
			Set Point2Add = New iPct
			Point2Add.X = A.Dt + A.Cz * t + A.By * t ^ 2 + A.Ax * t ^ 3
			Point2Add.Y = B.Dt + B.Cz * t + B.By * t ^ 2 + B.Ax * t ^ 3
			Point2Add.Z = C.Dt + C.Cz * t + C.By * t ^ 2 + C.Ax * t ^ 3
			BSpline3.Add Point2Add
			Set Point2Add = Nothing
		Next
		Set A = Nothing: Set B = Nothing: Set C = Nothing
	Next
End Function

Catia V5 VBA function to approximate an curve using Quadratic Bezier curves

Public Function BSplineC(CollectionOfiPcts As Collection, Increment As Double) As Collection
	Dim j As Double
	Dim t As Double
	Dim A As iPct: Dim B As iPct: Dim C As iPct: Dim Point2Add As iPct
	Set BSplineC = New Collection
	For j = 2 To CollectionOfiPcts.Count - 1
		Set A = New iPct: Set B = New iPct: Set C = New iPct
		A.X = (CollectionOfiPcts(j - 1).X - 2 * CollectionOfiPcts(j).X + CollectionOfiPcts(j + 1).X) / 2
		A.Y = (-2 * CollectionOfiPcts(j - 1).X + 2 * CollectionOfiPcts(j).X) / 2
		A.Z = (CollectionOfiPcts(j - 1).X + CollectionOfiPcts(j).X) / 2
		B.X = (CollectionOfiPcts(j - 1).Y - 2 * CollectionOfiPcts(j).Y + CollectionOfiPcts(j + 1).Y) / 2
		B.Y = (-2 * CollectionOfiPcts(j - 1).Y + 2 * CollectionOfiPcts(j).Y) / 2
		B.Z = (CollectionOfiPcts(j - 1).Y + CollectionOfiPcts(j).Y) / 2
		C.X = (CollectionOfiPcts(j - 1).Z - 2 * CollectionOfiPcts(j).Z + CollectionOfiPcts(j + 1).Z) / 2
		C.Y = (-2 * CollectionOfiPcts(j - 1).Z + 2 * CollectionOfiPcts(j).Z) / 2
		C.Z = (CollectionOfiPcts(j - 1).Z + CollectionOfiPcts(j).Z) / 2
		For t = 0 To 1 Step Increment
			Set Point2Add = New iPct
			Point2Add.X = A.Z + A.Y * t + A.X * t ^ 2
			Point2Add.Y = B.Z + B.Y * t + B.X * t ^ 2
			Point2Add.Z = C.Z + C.Y * t + C.X * t ^ 2
			BSplineC.Add Point2Add
			Set Point2Add = Nothing
		Next
		Set A = Nothing: Set B = Nothing: Set C = Nothing
	Next
End Function

Catia V5 VBA procedure to sort vectors

Public Sub SortVector(Array2Sort, Order As String)
	Dim X As Integer
	Dim Temp
	Select Case Order
		Case "A"
			Sorted = False
			Do While Not Sorted
				Sorted = True
				For X = 0 To UBound(Array2Sort) - 1
					If Array2Sort(X) > Array2Sort(X + 1) Then
						Temp = Array2Sort(X + 1)
						Array2Sort(X + 1) = Array2Sort(X)
						Array2Sort(X) = Temp
						Sorted = False
					End If
				Next X
			Loop
		Case "D"
			Sorted = False
			Do While Not Sorted
				Sorted = True
				For X = 0 To UBound(Array2Sort) - 1
					If Array2Sort(X) < Array2Sort(X + 1) Then
						Temp = Array2Sort(X + 1)
						Array2Sort(X + 1) = Array2Sort(X)
						Array2Sort(X) = Temp
						Sorted = False
					End If
				Next X
			Loop
		Case Else
			MsgBox "Invalid parameter Value Order=A or D"
	End Select
End Sub

Catia V5 VBA Function to get direction vector of a line

Public Function GetDirectionVector(FirstPoint As iPct, SecondPoint As iPct) As iPct
    GetDirectionVector.X = FirstPoint.X - SecondPoint.X
    GetDirectionVector.Y = FirstPoint.Y - SecondPoint.Y
    GetDirectionVector.Z = FirstPoint.Z - SecondPoint.Z
End Function

 Catia V5 VBA Function to get normal vector of a plane containing 2 lines

Public Function GetNormalVectorTwoLines(VectorA As iPct, VectorB As iPct) As iPct
    GetNormalVectorTwoLines.X = VectorA.Y * VectorB.Z - VectorA.Z * VectorB.Y
    GetNormalVectorTwoLines.Y = VectorA.Z * VectorB.X - VectorA.X * VectorB.Z
    GetNormalVectorTwoLines.Z = VectorA.X * VectorB.Y - VectorA.Y * VectorB.X
End Function

 Catia V5 VBA Function to get the distance between 2 lines

'Old function name has been changed for clarity
'Public Function LLDistance(PointA As Q.iPct, PointB As Q.iPct, PointC As Q.iPct, PointD As Q.iPct) As Double
Public Function LineToLineDistance(PointA As Q.iPct, PointB As Q.iPct, PointC As Q.iPct, PointD As Q.iPct) As Double
    Dim v As Q.iPct
    Dim w As Q.iPct
    Dim nv As Q.iPct
    Dim ux As Double, uy As Double, uz As Double
    Dim dotProduct As Double
    Dim nvLength As Double
    ' Calculate the direction vectors of each line
    v = GetDirectionVector(PointA, PointB)
    w = GetDirectionVector(PointC, PointD)
    ' Calculate the normal vector of the plane containing both lines
    nv = GetNormalVectorTwoLines(v, w)
    ' Calculate the vector between the two points on the first line and the second line
    ux = PointC.X - PointA.X: uy = PointC.Y - PointA.Y: uz = PointC.Z - PointA.Z
    ' Calculate the dot product of the vector between the two points and the normal vector of the plane
    dotProduct = ux * nv.X + uy * nv.Y + uz * nv.Z
    ' Calculate the length of the normal vector of the plane
    nvLength = Sqr(nv.X ^ 2 + nv.Y ^ 2 + nv.Z ^ 2)
    ' Divide the absolute value of the dot product by the length of the normal vector to get the minimum distance between the two lines
    LLDistance = Abs(dotProduct) / nvLength
End Function
Const PI As Double = 3.14159265358979
'Get point coordinates
Public Function GetPointXYZ(MyPoint As Variant) As iPct
    Dim Coord(2): Set GetPointXYZ = New iPct
    MyPoint.GetCoordinates Coord
    GetPointXYZ.X = Coord(0): GetPointXYZ.Y = Coord(1): GetPointXYZ.Z = Coord(2)
    Erase Coord
End Function
'Get point coordinates from a specified axis system
Public Function LCS(AxisSys As Variant, Point2Measure As iPct) As iPct
    Dim AOrig(2): Dim Vx(2): Dim Vy(2): Dim Vz(2)
    Dim iOrig As iPct: Dim iVx As iPct: Dim iVy As iPct: Dim iVz As iPct: Dim Diff As iPct
    Set LCS = New iPct
    AxisSys.GetOrigin AOrig: iOrig.X = AOrig(0): iOrig.Y = AOrig(1): iOrig.Z = AOrig(2)
    AxisSys.GetXAxis Vx: iVx.X = Vx(0): iVx.Y = Vx(1): iVx.Z = Vx(2)
    AxisSys.GetYAxis Vy: iVy.X = Vy(0): iVy.Y = Vy(1): iVy.Z = Vy(2)
    AxisSys.GetZAxis Vz: iVz.X = Vz(0): iVz.Y = Vz(1): iVz.Z = Vz(2)
    NormalizeVector iVx, iVx
    NormalizeVector iVy, iVy
    NormalizeVector iVz, iVz
    Diff.X = Point2Measure.X - iOrig.X: Diff.Y = Point2Measure.Y - iOrig.Y: Diff.Z = Point2Measure.Z - iOrig.Z
    LCS.X = DotProduct(Diff, iVx): LCS.Y = DotProduct(Diff, iVy): LCS.Z = DotProduct(Diff, iVz)
    Set iOrig = Nothing: Set iVx = Nothing: Set iVy = Nothing: Set iVz = Nothing: Set Diff = Nothing
    Erase AOrig: Erase Vx: Erase Vy: Erase Vz
End Function
'Normalizaton of a vector
Public Sub NormalizeVector(IVect As iPct, ByRef NVect As iPct)
    Dim Mag As Double
    Mag = Sqr(IVect.X ^ 2 + IVect.Y ^ 2 + IVect.Z ^ 2)
    If Mag < 0.0000001 Then Call Err.Raise(1001, , "Zero length vector cannot be normalized")
    NVect.X = IVect.X / Mag
    NVect.Y = IVect.Y / Mag
    NVect.Z = IVect.Z / Mag
End Sub
'Get Plane Equation
Public Function PlaneEquation(PartOrigin As iPct, PlaneOrigin As iPct, FirstVector As iPct, SecondVector As iPct) As iPlan
    Set PlaneEquation = New iPlan
    PlaneEquation.Ax = PartOrigin.Y * (FirstVector.Z - SecondVector.Z) + FirstVector.Y * (SecondVector.Z - PartOrigin.Z) + SecondVector.Y * (PartOrigin.Z - FirstVector.Z)
    PlaneEquation.By = PartOrigin.Z * (FirstVector.X - SecondVector.X) + FirstVector.Z * (SecondVector.X - PartOrigin.X) + SecondVector.Z * (PartOrigin.X - FirstVector.X)
    PlaneEquation.Cz = PartOrigin.X * (FirstVector.Y - SecondVector.Y) + FirstVector.X * (SecondVector.Y - PartOrigin.Y) + SecondVector.X * (PartOrigin.Y - FirstVector.Y)
    PlaneEquation.Dt = PlaneOrigin.X * (FirstVector.Y * SecondVector.Z - SecondVector.Y * FirstVector.Z) + FirstVector.X * (SecondVector.Y * PlaneOrigin.Z - PlaneOrigin.Y * _
                                                                                                                            SecondVector.Z) + SecondVector.X * (PlaneOrigin.Y * FirstVector.Z - FirstVector.Y * PlaneOrigin.Z)
End Function
'Get plane vectors
Public Function GetPlaneVectors(MyPlane As Variant) As iPct()
    Dim ArrRet() As iPct: ReDim ArrRet(1)
    Dim V1(2): Dim V2(2)
    MyPlane.GetFirstAxis V1: ArrRet(0).X = V1(0): ArrRet(0).Y = V1(1): ArrRet(0).Z = V1(2)
    MyPlane.GetSecondAxis V2: ArrRet(1).X = V2(0): ArrRet(1).Y = V2(1): ArrRet(1).Z = V2(2)
    GetPlaneVectors = ArrRet
    Erase ArrRet: Erase V1: Erase V2
End Function
'Get angle between two planes
Public Function DihedralAngle(FirstPlane As iPlan, SecondPlane As iPlan) As Double
    DihedralAngle = ArcCos(FirstPlane.Ax * SecondPlane.Ax + FirstPlane.By * SecondPlane.By + FirstPlane.Cz * SecondPlane.Cz / _
                           Sqr((FirstPlane.Ax ^ 2 + FirstPlane.By ^ 2 + FirstPlane.Cz ^ 2) * (SecondPlane.Ax ^ 2 + SecondPlane.By ^ 2 + SecondPlane.Cz ^ 2)))
End Function
'Nothing to comment
Public Function ArcCos(Radians As Double) As Double
    If Round(Radians, 8) = 1 Then ArcCos = 0: Exit Function
    If Round(Radians, 8) = -1 Then ArcCos = PI: Exit Function
    ArcCos = Atn(-Radians / Sqr(1 - Radians ^ 2)) + 2 * Atn(1)
End Function
'Nothing to comment
Public Function ArcSin(Radians As Double) As Double
    If (Sqr(1 - Radians ^ 2) <= 0.000000000001) And (Sqr(1 - Radians ^ 2) >= -0.000000000001) Then
        ArcSin = PI / 2
    Else
        ArcSin = Atn(Radians / Sqr(1 - Radians ^ 2))
    End If
End Function
'Get distance between two points
Public Function P2PDist(FirstPoint As iPct, SecondPoint As iPct) As Double
    Distance = Sqr((SecondPoint.X - FirstPoint.X) ^ 2 + (SecondPoint.Y - FirstPoint.Y) ^ 2 + (SecondPoint.Z - FirstPoint.Z) ^ 2)
End Function
'Are two points on the same side of the plane?
Public Function WhichSideOfPlane(Plane As iPlan, FirstPoint As iPct, SecondPoint As iPct) As Integer()
    Dim ArrReturn() As Integer: ReDim ArrReturn(1)
    ArrReturn(0) = Plane.Ax * FirstPoint.X + Plane.By * FirstPoint.Y + Plane.Cz * FirstPoint.Z - Plane.Dt
    ArrReturn(1) = Plane.Ax * SecondPoint.X + Plane.By * SecondPoint.Y + Plane.Cz * SecondPoint.Z - Plane.Dt
    WhichSideOfPlane = ArrReturn
    Erase ArrReturn
End Function
'Get the vector of a line
Public Function GetLineVector(FirstPoint As iPct, SecondPoint As iPct) As iPct
    Dim Dist As Double: Set GetLineVector = New iPct
    Dist = P2PDist(FirstPoint, Seconpoint)
    GetLineVector.X = (SecondPoint.X - FirstPoint.X) / Dist
    GetLineVector.Y = (SecondPoint.Y - FirstPoint.Y) / Dist
    GetLineVector.Z = (SecondPoint.Z - FirstPoint.Z) / Dist
End Function
'How to Get BREPNAME FROM CATIA
Public Function GetBrep(MyBRepName As String) As String
    MyBRepName = Replace(MyBRepName, "Selection_", "")
    MyBRepName = Left(MyBRepName, InStrRev(MyBRepName, "));"))
    MyBRepName = MyBRepName + ");WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)"
    '");WithTemporaryBody;WithoutBuildError;WithInitialFeatureSupport;MonoFond;MFBRepVersion _CXR14)"
    GetBrep = MyBRepName
End Function
'Determine if two lines are skew, intersecting or parallel
Public Function LLIntersect(A As iPct, B As iPct, C As iPct, D As iPct) As iIntersect
    Dim M(3, 3) As Double
    M(0, 0) = A.X: M(0, 1) = A.Y: M(0, 2) = A.Z: M(0, 3) = 1
    M(1, 0) = B.X: M(1, 1) = B.Y: M(1, 2) = B.Z: M(1, 3) = 1
    M(2, 0) = C.X: M(2, 1) = C.Y: M(2, 2) = C.Z: M(2, 3) = 1
    M(3, 0) = D.X: M(3, 1) = D.Y: M(3, 2) = D.Z: M(3, 3) = 1
    If GetDet(M) <> 0 Then Erase M: LLIntersect.Result = Oblice: Exit Function    'skew lines
    Dim CxB() As Double: Dim AxB() As Double: ReDim CxB(2): ReDim AxB(2)
    Dim Av(2) As Double: Dim Bv(2) As Double: Dim Cv(2) As Double
    Av(0) = B.X - A.X: Av(1) = B.Y - A.Y: Av(2) = B.Z - A.Z
    Bv(0) = D.X - C.X: Bv(1) = D.Y - C.Y: Bv(2) = D.Z - C.Z
    Cv(0) = C.X - A.X: Cv(1) = C.Y - A.Y: Cv(2) = C.Z - A.Z
    CxB = CrossProd(Cv, Bv): AxB = CrossProd(Av, Bv)
    Dim s As Double
    On Error GoTo paralelele
    s = DotProd(CxB, AxB) / Abs(DotProd(AxB, AxB))
    Dim iInter As iPct
    iInter.X = A.X + Av(0) * s    'X coordinate of intersection
    iInter.Y = A.Y + Av(1) * s    'Y coordinate of intersection
    iInter.Z = A.Z + Av(2) * s    'Z coordinate of intersection
    LLIntersect.Result = Intersectie    'intersecting lines
    LLIntersect.Val = iInter
paralelele:
    Erase CxB: Erase AxB: Erase Cv: Erase Bv: Erase Av
    If Err.Number <> 0 Then LLIntersect.Result = PParalele: Err.Clear    'parallel lines
End Function
'Get the distance between two skew lines
Public Function SkewLDist(A As iPct, B As iPct, C As iPct, D As iPct) As Double
    Dim Av(2) As Double: Dim Bv(2) As Double: Dim Cv(2) As Double
    Dim Det(2, 2) As Double
    Av(0) = A.X - B.X: Av(1) = A.Y - B.Y: Av(2) = A.Z - B.Z
    Bv(0) = C.X - A.X: Bv(1) = C.Y - A.Y: Bv(2) = C.Z - A.Z
    Cv(0) = D.X - C.X: Cv(1) = D.Y - C.Y: Cv(2) = D.Z - C.Z
    Det(0, 0) = DotProd(Cv, Cv): Det(0, 1) = DotProd(Cv, Av): Det(0, 2) = DotProd(Cv, Bv)
    Det(1, 0) = DotProd(Cv, Av): Det(1, 1) = DotProd(Av, Av): Det(1, 2) = DotProd(Av, Bv)
    Det(2, 0) = DotProd(Cv, Bv): Det(2, 1) = DotProd(Av, Bv): Det(2, 2) = DotProd(Bv, Bv)
    Dim v As Double
    v = GetDet(Det)
    SkewLDist = Sqr(v / (Det(0, 0) * Det(1, 1) - Det(1, 0) ^ 2))
End Function
'Get DOT product of two vectors - lenght must be 3
Public Function DotProd(V1() As Double, V2() As Double) As Double
    DotProd = V1(0) * V2(0) + V1(1) * V2(1) + V1(2) * V2(2)
End Function
'Get CROSS product of two vectors - lenght must be 3
Public Function CrossProd(V1() As Double, V2() As Double) As Double()
    Dim Res() As Double
    ReDim Res(2)
    Res(0) = V1(1) * V2(2) - V1(2) * V2(1)
    Res(1) = V1(2) * V2(0) - V1(0) * V2(2)
    Res(2) = V1(0) * V2(1) - V1(1) * V2(0)
    CrossProd = Res
    Erase Res
End Function
'Get inverse of an NxN matrix
Public Function GetInverse(M() As Double) As Double()
    Dim RetVal() As Double: Dim Size As Integer
    Dim Det As Double: Dim Adj() As Double
    Dim i As Integer: Dim j As Integer
    Size = UBound(M): Det = GetDet(M)
    If Det <> 0 Then
        ReDim RetVal(Size, Size)
        Adj = GetAdjoint(M)
        For i = 0 To Size
            For j = 0 To Size
                RetVal(i, j) = Adj(i, j) / Det
            Next
        Next
        Erase Adj
        GetInverse = RetVal
        Erase RetVal
    End If
End Function
'Get Determinant of an NxN matrix
Public Function GetDet(M() As Double) As Double
    Dim i As Integer: Dim j As Integer
    Dim Size As Integer: Size = UBound(M): Dim RetVal As Double
    If Size = 1 Then
        RetVal = RetVal + M(0, 0) * M(1, 1) - M(0, 1) * M(1, 0)   'daca e deteminant 2x2
    Else
        For i = 0 To Size
            RetVal = RetVal + ((-1) ^ i) * M(0, i) * GetDet(GetMinor(M, 0, i))    'daca e determinant NxN
        Next
    End If
    GetDet = RetVal
End Function
'Get Adjoint matrix - it is used to calculate the inverse of an NxN matrix
Public Function GetAdjoint(M() As Double) As Double()
    Dim i As Integer: Dim j As Integer
    Dim Size As Integer: Size = UBound(M)
    Dim RetVal() As Double: ReDim RV(Size, Size)
    For i = 0 To Size
        For j = 0 To Size
            RetVal(j, i) = ((-1) ^ (i + j)) * GetDet(GetMinor(M, i, j))    'RetVal(i, j)=matricea cofactor; RetVal(j, i)= transpusa matricii cofactor
        Next
    Next
    GetAdjoint = RetVal
    Erase RetVal
End Function
'Get Minor matrix - it is used to calculate the determinant of an NxN matrix
Public Function GetMinor(Min() As Double, RemRow As Integer, RemCol As Integer) As Double()
    Dim RetVal() As Double: Dim i As Integer: Dim j As Integer
    Dim IdxC As Integer: Dim IdxR As Integer
    Dim Size As Integer: IdxR = 0: Size = UBound(Min) - 1
    ReDim RetVal(Size, Size) As Double
    For i = 0 To Size + 1
        If i <> RemRow Then
            IdxC = 0
            For j = 0 To Size + 1
                If j <> RemCol Then
                    RetVal(IdxR, IdxC) = Min(i, j)
                    IdxC = IdxC + 1
                End If
            Next
            IdxR = IdxR + 1
        End If
    Next
    GetMinor = RetVal
    Erase RetVal
End Function
'How to aproximate an curve using Cubic Bezier curves
Public Function BSpline3(CollectionOfiPcts As Collection, Increment As Double) As Collection
    Dim i As Double: Dim t As Double
    Dim A As iPlan: Dim B As iPlan: Dim C As iPlan: Dim Point2Add As iPct
    Set BSpline3 = New Collection
    For i = 1 To CollectionOfiPcts.Count - 3
        Set A = New iPlan: Set B = New iPlan: Set C = New iPlan
        A.Ax = (-CollectionOfiPcts(i).X + 3 * CollectionOfiPcts(i + 1).X - 3 * CollectionOfiPcts(i + 2).X + CollectionOfiPcts(i + 3).X) / 6
        A.By = (3 * CollectionOfiPcts(i).X - 6 * CollectionOfiPcts(i + 1).X + 3 * CollectionOfiPcts(i + 2).X) / 6
        A.Cz = (-3 * CollectionOfiPcts(i).X + 3 * CollectionOfiPcts(i + 2).X) / 6
        A.Dt = (CollectionOfiPcts(i).X + 4 * CollectionOfiPcts(i + 1).X + CollectionOfiPcts(i + 2).X) / 6
        B.Ax = (-CollectionOfiPcts(i).Y + 3 * CollectionOfiPcts(i + 1).Y - 3 * CollectionOfiPcts(i + 2).Y + CollectionOfiPcts(i + 3).Y) / 6
        B.By = (3 * CollectionOfiPcts(i).Y - 6 * CollectionOfiPcts(i + 1).Y + 3 * CollectionOfiPcts(i + 2).Y) / 6
        B.Cz = (-3 * CollectionOfiPcts(i).Y + 3 * CollectionOfiPcts(i + 2).Y) / 6
        B.Dt = (CollectionOfiPcts(i).Y + 4 * CollectionOfiPcts(i + 1).Y + CollectionOfiPcts(i + 2).Y) / 6
        C.Ax = (-CollectionOfiPcts(i).Z + 3 * CollectionOfiPcts(i + 1).Z - 3 * CollectionOfiPcts(i + 2).Z + CollectionOfiPcts(i + 3).Z) / 6
        C.By = (3 * CollectionOfiPcts(i).Z - 6 * CollectionOfiPcts(i + 1).Z + 3 * CollectionOfiPcts(i + 2).Z) / 6
        C.Cz = (-3 * CollectionOfiPcts(i).Z + 3 * CollectionOfiPcts(i + 2).Z) / 6
        C.Dt = (CollectionOfiPcts(i).Z + 4 * CollectionOfiPcts(i + 1).Z + CollectionOfiPcts(i + 2).Z) / 6
        For t = 0 To 1 Step Increment
            Set Point2Add = New iPct
            Point2Add.X = A.Dt + A.Cz * t + A.By * t ^ 2 + A.Ax * t ^ 3
            Point2Add.Y = B.Dt + B.Cz * t + B.By * t ^ 2 + B.Ax * t ^ 3
            Point2Add.Z = C.Dt + C.Cz * t + C.By * t ^ 2 + C.Ax * t ^ 3
            BSpline3.Add Point2Add
            Set Point2Add = Nothing
        Next
        Set A = Nothing: Set B = Nothing: Set C = Nothing
    Next
End Function
'How to aproximate an curve using Quadratic Bezier curves
Public Function BSplineC(CollectionOfiPcts As Collection, Increment As Double) As Collection
    Dim j As Double
    Dim t As Double
    Dim A As iPct: Dim B As iPct: Dim C As iPct: Dim Point2Add As iPct
    Set BSplineC = New Collection
    For j = 2 To CollectionOfiPcts.Count - 1
        Set A = New iPct: Set B = New iPct: Set C = New iPct
        A.X = (CollectionOfiPcts(j - 1).X - 2 * CollectionOfiPcts(j).X + CollectionOfiPcts(j + 1).X) / 2
        A.Y = (-2 * CollectionOfiPcts(j - 1).X + 2 * CollectionOfiPcts(j).X) / 2
        A.Z = (CollectionOfiPcts(j - 1).X + CollectionOfiPcts(j).X) / 2
        B.X = (CollectionOfiPcts(j - 1).Y - 2 * CollectionOfiPcts(j).Y + CollectionOfiPcts(j + 1).Y) / 2
        B.Y = (-2 * CollectionOfiPcts(j - 1).Y + 2 * CollectionOfiPcts(j).Y) / 2
        B.Z = (CollectionOfiPcts(j - 1).Y + CollectionOfiPcts(j).Y) / 2
        C.X = (CollectionOfiPcts(j - 1).Z - 2 * CollectionOfiPcts(j).Z + CollectionOfiPcts(j + 1).Z) / 2
        C.Y = (-2 * CollectionOfiPcts(j - 1).Z + 2 * CollectionOfiPcts(j).Z) / 2
        C.Z = (CollectionOfiPcts(j - 1).Z + CollectionOfiPcts(j).Z) / 2
        For t = 0 To 1 Step Increment
            Set Point2Add = New iPct
            Point2Add.X = A.Z + A.Y * t + A.X * t ^ 2
            Point2Add.Y = B.Z + B.Y * t + B.X * t ^ 2
            Point2Add.Z = C.Z + C.Y * t + C.X * t ^ 2
            BSplineC.Add Point2Add
            Set Point2Add = Nothing
        Next
        Set A = Nothing: Set B = Nothing: Set C = Nothing
    Next
End Function
'Vector sorting
Public Sub SortVector(Array2Sort, Order As String)
    Dim X As Integer
    Dim Temp
    Select Case Order
    Case "A"
        Sorted = False
        Do While Not Sorted
            Sorted = True
            For X = 0 To UBound(Array2Sort) - 1
                If Array2Sort(X) > Array2Sort(X + 1) Then
                    Temp = Array2Sort(X + 1)
                    Array2Sort(X + 1) = Array2Sort(X)
                    Array2Sort(X) = Temp
                    Sorted = False
                End If
            Next X
        Loop
    Case "D"
        Sorted = False
        Do While Not Sorted
            Sorted = True
            For X = 0 To UBound(Array2Sort) - 1
                If Array2Sort(X) < Array2Sort(X + 1) Then
                    Temp = Array2Sort(X + 1)
                    Array2Sort(X + 1) = Array2Sort(X)
                    Array2Sort(X) = Temp
                    Sorted = False
                End If
            Next X
        Loop
    Case Else
        MsgBox "Invalid parameter Value Order=A or D"
    End Select
End Sub

Comments powered by CComment