Hallo Lionel,
jede Antwort hilft weiter, deshalb Danke.
Hier nochmal Problemstellung und (eine mögliche) Lösung dazu:
Gegeben:
- Punktekoordinaten X,Y,Z im Rootprodukt (Absolutes Achsensystem)
- Ein positioniertes Catpart (verschoben + gedreht) in einer beliebigen Unterproduktstruktur
Gesucht:
Koordinaten dieses Punktes in Bezug zum Achsensystem des Catparts
Lösungsbeispiel (hier für Punkt absolut X50 Y100 Z20):
Sub CATMain()
Dim oSelection As Selection
Set oSelection = CATIA.ActiveDocument.Selection
Dim oRoot As Product
Set oRoot = CATIA.ActiveDocument.Product
Dim oChildProduct As AnyObject
Set oChildProduct = oSelection.Item(1).Value
' Absolute Position des Parts oder Unterproduktes im Rootprodukt berechnen
Dim ChildAbsolutePosition(11)
GetAbsPosition oChildProduct, oRoot, ChildAbsolutePosition
' Position des Punktes im Achsensystem des Parts oder Unterproduktes berechnen
Dim PositionImPart(11)
Dim PositionImRootproduct(11)
Dim InverseOfChildAbsolutePosition(11)
MatrixInverse ChildAbsolutePosition, InverseOfChildAbsolutePosition
PositionImRootproduct(0) = 1# ' X-Vektor: X
PositionImRootproduct(1) = 0# ' X-Vektor: Y
PositionImRootproduct(2) = 0# ' X-Vektor: Z
PositionImRootproduct(3) = 0# ' Y-Vektor: X
PositionImRootproduct(4) = 1# ' Y-Vektor: Y
PositionImRootproduct(5) = 0# ' Y-Vektor: Z
PositionImRootproduct(6) = 0# ' Z-Vektor: X
PositionImRootproduct(7) = 0# ' Z-Vektor: Y
PositionImRootproduct(8) = 1# ' Z-Vektor: Z
PositionImRootproduct(9) = 50 ' Punkt X
PositionImRootproduct(10) = 100 ' Punkt Y
PositionImRootproduct(11) = 20 ' Punkt Z
MatrixProduct PositionImRootproduct, InverseOfChildAbsolutePosition, PositionImPart
MsgBox "Position des Punktes im Achsensystem des Parts oder Unterproduktes" & vbNewLine & vbNewLine & "X " & PositionImPart(9) & " Y " & PositionImPart(10) & " Z " & PositionImPart(11)
End Sub
' ***********************************************************************
'
' Purpose: Define the product of two matrix.
'
' Inputs : matrix1 Array array corresponding to the first matrix
' matrix2 Array array corresponding to the second matrix
'
' Outputs: res Array array corresponding to the product
'
' ***********************************************************************
Sub MatrixProduct(ByVal matrix1, ByVal matrix2, ByRef res)
Dim a(11)
Dim b(11)
Dim I As Integer
For I = 0 To 11
a(I) = matrix1(I)
b(I) = matrix2(I)
Next
res(0) = a(0) * b(0) + a(1) * b(3) + a(2) * b(6)
res(3) = a(3) * b(0) + a(4) * b(3) + a(5) * b(6)
res(6) = a(6) * b(0) + a(7) * b(3) + a(8) * b(6)
res(1) = a(0) * b(1) + a(1) * b(4) + a(2) * b(7)
res(4) = a(3) * b(1) + a(4) * b(4) + a(5) * b(7)
res(7) = a(6) * b(1) + a(7) * b(4) + a(8) * b(7)
res(2) = a(0) * b(2) + a(1) * b(5) + a(2) * b(8)
res(5) = a(3) * b(2) + a(4) * b(5) + a(5) * b(8)
res(8) = a(6) * b(2) + a(7) * b(5) + a(8) * b(8)
res(9) = a(9) * b(0) + a(10) * b(3) + a(11) * b(6) + b(9)
res(10) = a(9) * b(1) + a(10) * b(4) + a(11) * b(7) + b(10)
res(11) = a(9) * b(2) + a(10) * b(5) + a(11) * b(8) + b(11)
End Sub
' ***********************************************************************
'
' Purpose: Define the inverse of a position matrix.
'
' Inputs : matrix Array array corresponding to the matrix
'
' Outputs: inverse Array array corresponding to the inverse of the matrix
'
' ***********************************************************************
Sub MatrixInverse(ByVal matrix, ByRef inverse)
Dim a(11)
Dim I As Integer
For I = 0 To 11
a(I) = matrix(I)
Next
inverse(0) = a(4) * a(8) - a(7) * a(5)
inverse(1) = a(2) * a(7) - a(8) * a(1)
inverse(2) = a(1) * a(5) - a(4) * a(2)
inverse(3) = a(5) * a(6) - a(8) * a(3)
inverse(4) = a(0) * a(8) - a(6) * a(2)
inverse(5) = a(2) * a(3) - a(5) * a(0)
inverse(6) = a(3) * a(7) - a(6) * a(4)
inverse(7) = a(1) * a(6) - a(7) * a(0)
inverse(8) = a(0) * a(4) - a(1) * a(3)
inverse(9) = -(a(9) * inverse(0) + a(10) * inverse(3) + a(11) * inverse(6))
inverse(10) = -(a(9) * inverse(1) + a(10) * inverse(4) + a(11) * inverse(7))
inverse(11) = -(a(9) * inverse(2) + a(10) * inverse(5) + a(11) * inverse(8))
End Sub
' ***********************************************************************
'
' Purpose: Retrieve the absolute position of a product.
'
' Inputs : oProduct Product the product
' oRoot Product the root product
'
' Outputs: position Array array corresponding to position of the product
'
' ***********************************************************************
Sub GetAbsPosition(ByRef oProduct, ByRef oRoot, ByRef Position)
If (oProduct.Name = oRoot.Name) Then
Position(0) = 1#
Position(1) = 0#
Position(2) = 0#
Position(3) = 0#
Position(4) = 1#
Position(5) = 0#
Position(6) = 0#
Position(7) = 0#
Position(8) = 1#
Position(9) = 0#
Position(10) = 0#
Position(11) = 0#
Else
Dim positionToFather(11)
Dim fatherAbsolutePosition(11)
oProduct.Position.GetComponents positionToFather
GetAbsPosition oProduct.Parent.Parent, oRoot, fatherAbsolutePosition
MatrixProduct positionToFather, fatherAbsolutePosition, Position
End If
End Sub
Gruß
Bernd
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP