Give this behemoth a whirl. Please note that it is a macro, so you will need to use the vba environment to run it.
From there you can add it to keyboard shortcuts to make it work, or run it from the Macro Menu.
What the rule does is force you to select 2 orthogonal faces and aligns the first one with the xy plane, and the 2nd one with the xz plane.
Sub Main()
Dim oDoc As PartDocument
Set oDoc = ThisApplication.ActiveDocument
If oDoc Is Nothing Then
MsgBox "No part document!" & vbCrLf & "Please open a part with solids in it for this sample to run.", vbCritical, "Autodesk Inventor"
Exit Sub
End If
Dim oCompDef As PartComponentDefinition
Set oCompDef = oDoc.ComponentDefinition
If oCompDef.SurfaceBodies.Count = 0 Then
MsgBox "No solids to move!" & vbCrLf & "Please open a part with solids in it for this sample to run.", vbCritical, "Autodesk Inventor"
Exit Sub
End If
Dim oBodies As ObjectCollection
Set oBodies = ThisApplication.TransientObjects.CreateObjectCollection
' Specify a body to move.
oBodies.Add oCompDef.SurfaceBodies(1)
Call RotatePart(oCompDef, oBodies)
oBodies.Clear
oBodies.Add oCompDef.SurfaceBodies(1)
Call MovePart(oCompDef, oBodies)
End Sub
Sub RotatePart(ByVal oCompDef As ComponentDefinition, ByVal oBodies As ObjectCollection)
'http://adndevblog.typepad.com/manufacturing/2012/08/what-is-the-best-way-to-compute-a-normal-of-a-face-in-inventor-api.html
' Create a MoveFeatureDefinition.
Dim oMoveDef As MoveDefinition
Set oMoveDef = oCompDef.Features.MoveFeatures.CreateMoveDefinition(oBodies)
Dim Face1 As Face
Dim Face2 As Face
Dim boolFace1IsPlane As Boolean
boolFace1IsPlane = False
Do
Set Face1 = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFaceFilter, "Pick FACE to align with XY Plane (FRONT)")
If (TypeOf Face1.Geometry Is Plane) Then
boolFace1IsPlane = True
End If
Loop Until boolFace1IsPlane
Dim oFace1Normal As Vector
Set oFace1Normal = ThisApplication.TransientGeometry.CreateVector()
Set oFace1Normal = GetFaceNormal(Face1)
Dim boolFace2IsPlane As Boolean
boolFace2IsPlane = False
Dim boolPlanesat90 As Boolean
boolPlanesat90 = False
Dim oFace2Normal As Vector
Set oFace2Normal = ThisApplication.TransientGeometry.CreateVector()
Do
boolFace2IsPlane = False
Do
Set Face2 = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFaceFilter, "Pick FACE to align with XZ Plane (TOP)")
If (TypeOf Face2.Geometry Is Plane) Then
boolFace1IsPlane = True
End If
Loop Until boolFace1IsPlane
Set oFace2Normal = GetFaceNormal(Face2)
'Perpindicular vectors have dot product of zero.
'Need to handle round of errors in doing the large vectors maths
If VBA.Round(oFace1Normal.DotProduct(oFace2Normal), 8) = 0 Then
boolPlanesat90 = True
End If
Loop Until boolPlanesat90
Dim oYZPlane As WorkPlane
Dim oXZPlane As WorkPlane
Dim oXYPlane As WorkPlane
Set oYZPlane = oCompDef.WorkPlanes.Item(1)
Set oXZPlane = oCompDef.WorkPlanes.Item(2)
Set oXYPlane = oCompDef.WorkPlanes.Item(3)
Dim oXAxis As WorkAxis
Set oXAxis = oCompDef.WorkAxes(1)
Dim oYAxis As WorkAxis
Set oYAxis = oCompDef.WorkAxes(2)
Dim oZAxis As WorkAxis
Set oZAxis = oCompDef.WorkAxes(3)
'Perform first rotation to align with coord system
Dim oRotationAngle As Double
oRotationAngle = GetRotationAngleAboutAxisToPlane(oFace1Normal, oXAxis, oXYPlane)
'oRotationAngle = GetRotationAngleAboutAxisToPlane(ThisApplication.TransientGeometry.CreateVector(oFace1Normal.X, oFace1Normal.Y, oFace1Normal.Z), oXAxis, oXYPlane)
Dim oRotateAboutAxis As RotateAboutLineMoveOperation
Set oRotateAboutAxis = oMoveDef.AddRotateAboutAxis(oXAxis, True, oRotationAngle)
Dim oRes1Vector As Vector
Set oRes1Vector = ThisApplication.TransientGeometry.CreateVector()
Set oRes1Vector = RotateVectorAboutAnotherVector(oRotationAngle, oFace1Normal, ThisApplication.TransientGeometry.CreateVector(oXAxis.Line.Direction.X, oXAxis.Line.Direction.Y, oXAxis.Line.Direction.Z))
Dim oRes1UpVector As Vector
Set oRes1UpVector = ThisApplication.TransientGeometry.CreateVector()
Set oRes1UpVector = RotateVectorAboutAnotherVector(oRotationAngle, oFace2Normal, ThisApplication.TransientGeometry.CreateVector(oXAxis.Line.Direction.X, oXAxis.Line.Direction.Y, oXAxis.Line.Direction.Z))
'Perform 2nd rotation to align with coord system
'oRotationAngle = GetRotationAngleAboutAxisToPlane(oFace1Normal, oYAxis, oXYPlane)
oRotationAngle = GetRotationAngleAboutAxisToPlane(oRes1Vector, oYAxis, oXYPlane)
Set oRotateAboutAxis = oMoveDef.AddRotateAboutAxis(oYAxis, True, oRotationAngle)
Dim oRes2UpVector As Vector
Set oRes2UpVector = ThisApplication.TransientGeometry.CreateVector()
Set oRes2UpVector = RotateVectorAboutAnotherVector(oRotationAngle, oRes1UpVector, ThisApplication.TransientGeometry.CreateVector(oYAxis.Line.Direction.X, oYAxis.Line.Direction.Y, oYAxis.Line.Direction.Z))
'Perform 3rd rotation to get Upvector oriented properly.
oRotationAngle = GetRotationAngleAboutAxisToPlane(oRes2UpVector, oZAxis, oXZPlane)
Set oRotateAboutAxis = oMoveDef.AddRotateAboutAxis(oZAxis, True, oRotationAngle)
Dim oMoveFeature As MoveFeature
Set oMoveFeature = oCompDef.Features.MoveFeatures.Add(oMoveDef)
End Sub
Function GetFaceNormal(ByVal oFace As Object) As Vector
Dim oNormal As Vector
Dim Params(1 To 2) As Double
Dim Normals(1 To 3) As Double
Params(1) = 0
Params(2) = 0
If TypeOf oFace Is WorkPlane Then
Call oFace.Plane.Evaluator.GetNormal(Params, Normals)
Set oNormal = ThisApplication.TransientGeometry.CreateVector(Normals(1), Normals(2), Normals(3))
Else
If (TypeOf oFace.Geometry Is Plane) Then
'Dim oEvalFace As Face
'Set oEvalFace = oFace
Call oFace.Evaluator.GetNormal(Params, Normals)
Set oNormal = ThisApplication.TransientGeometry.CreateVector(Normals(1), Normals(2), Normals(3))
End If
End If
Set GetFaceNormal = oNormal
End Function
Function GetRotationAngleAboutAxisToPlane(ByVal oVector As Vector, ByVal oAxis As WorkAxis, ByVal oWorkPlane As WorkPlane) As Double
''http://onlinemschool.com/math/library/vector/angl/
'This ProjectVectorToPlane removes the 1 of the 3 components in relation to the plane.
'IN this case, to the YZ plane, it essentially removes the X component and scales it slightly.
'Verified method below also works, but gives same results as the formulaic method.
'Dim AltProject As Vector
'Set AltProject = ThisApplication.TransientGeometry.CreateVector(0, oFace1Normal.Y, oFace1Normal.Z)
'Angle is insufficient as it doesn't have a direction.
'Use Cross product to find the angle and direction
' Length of this crossproduct is actually the area of the parallellogram of A & B
' The vector gives the direction
'If the vectors x component is positive, it means that we need to rotate
'it the same direction as the x axis (ie cw), and if its negative, we rotate it the negative direction
Dim oLineDir As Variant
Set oLineDir = oAxis.Line.Direction
'oLine.Direction (oCoords)
Dim oAxisVector As Vector
Set oAxisVector = ThisApplication.TransientGeometry.CreateVector(oLineDir.X, oLineDir.Y, oLineDir.Z)
'oRotationAngle = AltProject.AngleTo(oYVector)
Dim oProjVec As Vector
Set oProjVec = ThisApplication.TransientGeometry.CreateVector()
'Project to plane perpindicular to plane
Set oProjVec = ProjectVectorToPerpindicularPlaneOfAnAxis(oVector, oAxisVector)
'Get the
Dim oWorkPlaneNormal As Vector
Set oWorkPlaneNormal = ThisApplication.TransientGeometry.CreateVector()
Set oWorkPlaneNormal = GetFaceNormal(oWorkPlane)
Dim oCrossProductVector As Vector
Set oCrossProductVector = ThisApplication.TransientGeometry.CreateVector
Set oCrossProductVector = oWorkPlaneNormal.CrossProduct(oProjVec)
oAngle = ArcSin(oCrossProductVector.Length / (oWorkPlaneNormal.Length * oProjVec.Length))
rotdir = 1
If oAxisVector.DotProduct(oCrossProductVector) > 0 Then
rotdir = -1
End If
GetRotationAngleAboutAxisToPlane = rotdir * oAngle
End Function
Function ProjectVectorToPerpindicularPlaneOfAnAxis(ByVal oVector As Vector, ByVal oPlaneNormal As Vector) As Vector
'https://www.maplesoft.com/support/help/maple/view.aspx?path=MathApps%2FProjectionOfVectorOntoPlane
'Projected vector = orig vector(term1) - (dp(u*N)/mag(n)^2)*n
Dim oByValVector As Vector
Set oByValVector = ThisApplication.TransientGeometry.CreateVector(oVector.X, oVector.Y, oVector.Z)
Dim oByValPlaneNormal As Vector
Set oByValPlaneNormal = ThisApplication.TransientGeometry.CreateVector(oPlaneNormal.X, oPlaneNormal.Y, oPlaneNormal.Z)
Dim oDotproductxun As Double
oDotproductxun = oByValVector.DotProduct(oByValPlaneNormal)
If oDotproductxun <> 0 Then
Dim magxn As Double
oMagxn = oByValPlaneNormal.Length
Dim oScalarComponent As Double
oScalarComponent = (oDotproductxun) / (oMagxn * oMagxn)
Call oByValPlaneNormal.ScaleBy(oScalarComponent)
Call oByValVector.SubtractVector(oByValPlaneNormal)
End If
Set ProjectVectorToPerpindicularPlaneOfAnAxis = oByValVector
End Function
Function ArcSin(ByVal X As Double) As Double
'http://cuinl.tripod.com/Tips/math9.htm
ArcSin = Atn(X / Sqr(-X * X + 1))
End Function
Function RotateVectorAboutAnotherVector(ByVal oTheta As Double, ByVal oRotatingVector As Vector, ByVal oStationaryVector As Vector) As Vector
'Let A be the rotating vector
'Let B be the stationary vector
Dim oVectorA As Vector
Dim oVectorB As Vector
Set oVectorA = ThisApplication.TransientGeometry.CreateVector(oRotatingVector.X, oRotatingVector.Y, oRotatingVector.Z)
Set oVectorB = ThisApplication.TransientGeometry.CreateVector(oStationaryVector.X, oStationaryVector.Y, oStationaryVector.Z)
Dim oMatrix As Matrix
Set oMatrix = ThisApplication.TransientGeometry.CreateMatrix
Call oMatrix.SetToRotation(oTheta, oVectorB, ThisApplication.TransientGeometry.CreatePoint(0, 0, 0))
Call oVectorA.TransformBy(oMatrix)
Set RotateVectorAboutAnotherVector = oVectorA
End Function
Sub MovePart(ByVal oCompDef As ComponentDefinition, ByVal oBodies As ObjectCollection)
Dim oMoveDef As MoveDefinition
Set oMoveDef = oCompDef.Features.MoveFeatures.CreateMoveDefinition(oBodies)
Set oRangeBox = oBodies.Item(1).RangeBox
oMidX = (oRangeBox.MaxPoint.X + oRangeBox.MinPoint.X) / 2
oMidY = (oRangeBox.MaxPoint.Y + oRangeBox.MinPoint.Y) / 2
oMidZ = (oRangeBox.MaxPoint.Z + oRangeBox.MinPoint.Z) / 2
Dim oFreeDrag As FreeDragMoveOperation
Set oFreeDrag = oMoveDef.AddFreeDrag(-1 * oMidX, -1 * oMidY, -1 * oMidZ)
Dim oMoveFeature As MoveFeature
Set oMoveFeature = oCompDef.Features.MoveFeatures.Add(oMoveDef)
End Sub
--------------------------------------
Did you find this reply helpful ? If so please use the 'Accept as Solution' or 'Like' button below.