Message 1 of 1
Ilogic save part location and orientation

Not applicable
07-13-2017
04:09 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
how to save te position of a part in to excel to restore later on in a new assy. To do that I want to save the xyz origin and the x,y,z angle.
I think somone with matrix exprerience and good knowledge of mathematics can solve this.
#Region get x, y, z 'this works Private Sub GetOccOrigin(oOcc As ComponentOccurrence, ByRef CoordinateX As String, ByRef CoordinateY As String, ByRef CoordinateZ As String)', ByRef ptX As Double,ByRef ptY As Double,ByRef ptZ As Double) 'Dim oUOM As UnitsOfMeasure = ThisApplication.ActiveDocument.UnitsOfMeasure ' Get the current transformation matrix from the occurrence. Dim oTransform As Matrix oTransform = oOcc.Transformation Dim oOriginLocation As Vector oOriginLocation = oTransform.Translation Dim uom As UnitsOfMeasure = ThisDoc.Document.UnitsOfMeasure Dim convFactor As Double = uom.ConvertUnits(1.0, uom.LengthUnits, UnitsTypeEnum.kDatabaseLengthUnits) 'ptX = oUOM.ConvertUnits(oOriginLocation.X, "cm", "in") ptX = oOriginLocation.X/convFactor'oUOM.ConvertUnits(oOriginLocation.X, "mm", "mm") ptY = oOriginLocation.Y/convFactor'oUOM.ConvertUnits(oOriginLocation.Y, "mm", "mm") ptZ = oOriginLocation.Z/convFactor'oUOM.ConvertUnits(oOriginLocation.Z, "mm", "mm") CoordinateX=CStr(Round(ptX,2)) CoordinateY=CStr(Round(ptY,2))'Coordinates & " ; " & CStr(Round(ptY,2)) CoordinateZ=CStr(Round(ptZ,2))'Coordinates & " ; " & CStr(Round(ptZ,2)) End Sub #End Region #Region "get angel" something is wrong in the mathematics or the refered me the right value 'finally the function that retrieves the rotations: Public Sub GetAngleOfOccurence(ByVal itemlist As ArrayList,ByRef ArrayXRotation As ArrayList, ByRef ArrayYRotation As ArrayList, ByRef ArrayZRotation As ArrayList) Dim oDoc As Inventor.Document= ThisApplication.ActiveDocument Dim oOcc As ComponentOccurrence Dim attSet As AttributeSet Select Case oDoc.DocumentType Case kAssemblyDocumentObject If itemlist.count <> 0 Then For i=0 To itemlist.count-1 oOcc = Component.InventorComponent(itemlist(i)) Dim oMatrix As Matrix= oOcc.Transformation Call oMatrix.GetMatrixData(trans) PI = 3.14159265358979 RadToDeg = 180 / PI 'Vector X - X-waarde 'Vector Y - waarde X 'Vector Z - waarde X 'Origin - waarde X 'Vector X - Y-waarde 'Vector Y - Y-waarde 'Vector Z - Y-waarde 'Oorsprong - y 'Vector X - waarde Z 'Vector Y - Z-waarde 'Vector Z - Z-waarde 'Origin - waarde Z 'leeg 'leeg 'leeg Call EulerAngles(AngelX, AngelY, AngelZ) ArrayXRotation.add(CStr(Round(AngelX,2))) ArrayYRotation.add(CStr(Round(AngelY,2))) ArrayZRotation.add(CStr(Round(AngelZ,2))) Next i End If End Select Public Function Atan2custom(ByVal y As Double,ByVal x As Double) ' returned value is in radians If x > 0 Then 'Atan2 = VBA.Atn(y / x) Atan2custom = System.Math.Atan(y / x) ElseIf (x < 0 And y >= 0) Then 'Atan2 = VBA.Atn(y / x) + PI Atan2custom = System.Math.Atan(y / x) + PI ElseIf (x < 0 And y < 0) Then 'Atan2 = VBA.Atn(y / x) - PI Atan2custom = System.Math.Atan(y / x) - PI ElseIf (x = 0 And y > 0) Then Atan2custom = PI / 2 ElseIf (x = 0 And y < 0) Then Atan2custom = -PI / 2 ElseIf (x = 0 And y = 0) Then Atan2custom = 0 End If End Function Public Function ArcSin(x As Double) As Double ' returned value is in radians ArcSin = System.Math.Atan(x / System.Math.Sqrt(-x * x + 1)) End Function Public Function ArcCos(x As Double) As Double ' returned value is in radians ArcCos = System.Math.Atan(-x / System.Math.Sqrt(-x * x + 1)) + 2 * Math.Atan(1) End Function Public Function Eulerz'(ByVal trans() As Double) ' returned value is in radians If (trans(8) <> 1 And trans(8) <> -1) Then Eulerz= Atan2custom(trans(4) / System.Math.Cos(ArcSin(trans(8))), trans(0) / System.Math.Cos(ArcSin(trans(8)))) Else Eulerz= 0 End If End Function Public Function Eulery ' returned value is in radians If (trans(8) <> 1 And trans(8) <> -1) Then Eulery= -ArcSin(trans(8)) ElseIf (trans(8) = -1) Then Eulery= PI / 2 Else Eulery= -PI / 2 End If End Function Public Function Eulerx ' returned value is in radians If (trans(8) <> 1 And trans(8) <> -1) Then Eulerx= Atan2custom(trans(9) / Cos(ArcSin(trans(8))), trans(10) / Cos(ArcSin(trans(8)))) ElseIf (trans(8) = -1) Then Eulerx= Atan2custom(trans(1), trans(2)) Else Eulerx= Atan2custom(-trans(1), -trans(2)) End If End Function Private Function EulerAngles(ByRef AngelX As Double, ByRef AngelY As Double, ByRef AngelZ As Double ) 'convert from radian to degree AngelX = Eulerx* RadToDeg AngelY = Eulery * RadToDeg AngelZ = Eulerz() * RadToDeg End Function End Sub #End Region 'than place component ' this works Private Sub PlaceComponent (ByVal X As Double,ByVal Y As Double,ByVal Z As Double,ByVal oPath As String, ByRef NewItemName As String) If System.IO.File.Exists(oPath) Then Dim oAsmCompDef As AssemblyComponentDefinition Dim oTG As TransientGeometry = ThisApplication.TransientGeometry Dim oMatrix As Matrix = oTG.CreateMatrix Dim oOccurrence As ComponentOccurrence Dim uom As UnitsOfMeasure = ThisDoc.Document.UnitsOfMeasure Dim convFactor As Double = uom.ConvertUnits(1.0, uom.LengthUnits, UnitsTypeEnum.kDatabaseLengthUnits) 'get user input ' X = InputBox("Enter X", "Title", X) ' Y = InputBox("Enter Y", "Title", Y) ' Z = InputBox("Enter Z", "Title", Z) oMatrix.SetTranslation(oTG.CreateVector(X*convFactor, Y*convFactor, Z*convFactor)) oAsmCompDef = ThisApplication.ActiveDocument.ComponentDefinition oOccurrence = oAsmCompDef.Occurrences.Add(oPath, oMatrix) ThisApplication.ActiveView.Fit Else MsgBox("File does not exist = " & oPath) End If End Sub 'than rotate ' Sub RotateAroundAxis(ByVal NewItemName As String , ByRef ArrayRotationX As ArrayList , ByRef ArrayRotationY As ArrayList, ByRef ArrayRotationZ As ArrayList) ..