Create Motion Envelope in NX 11

Is there anyway that I can create motion envelope in NX 11 using the existing arrangements. or simply using the move component option. Currently we have the options in Kinematics and sequence, Which both won't be useful for us (We have 4 bar mechanism and lot of pivots). The arrangements we are using a different automation method which will move components based Csys to Csys to based on expression and a basic sketch (We avoid kinematics to save time.) This below code I created for assembly arrangement creation using sketch, expression, CSYS, Table and component groups (Kinematics taking too long for each time update it saves me like 95% of time than kinematics).

Option Strict Off
Imports System
Imports System.IO
Imports System.Windows.Forms
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Collections
Imports System.Runtime.InteropServices
Imports NXOpen
Imports NXOpen.GeometricUtilities
Imports NXOpen.UF
Imports NXOpen.Assemblies
Imports NXOpenUI
Imports System.Collections.Generic

Module ArrangementUpdateNew

Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim theUI As UI = UI.GetUI
Dim ufs As UFSession = UFSession.GetUFSession
Dim lw As ListingWindow = theSession.ListingWindow

Sub Main()
lw.Open()
Dim i As Integer = Nothing
Dim j As Integer = Nothing
Dim k As Integer = Nothing
Dim ii As Integer = Nothing
Dim ij As Integer = Nothing
Dim ik As Integer = Nothing
Dim PrimeCsysList As List(Of CoordinateSystem) = New List(Of CoordinateSystem)
Dim SecondaryCsysList As List(Of CoordinateSystem) = New List(Of CoordinateSystem)
Dim GroupList As List(Of ComponentGroup) = New List(Of ComponentGroup)
Dim FromOrigin() As Double = Nothing
Dim FromXAxis() As Double = Nothing
Dim FromYAxis() As Double = Nothing
Dim ArrangementTable As Tag = Nothing
Dim Cellvalue As String = Nothing
Dim numRows As Integer = Nothing
Dim numCols As Integer = Nothing
Dim rowTag As Tag = Nothing
Dim colTag As Tag = Nothing
Dim cellTag As Tag = Nothing
Dim ArrangementName As String = Nothing
Dim VariablesTitle As List(Of String) = New List(Of String)
Dim DelArrangementList As List(Of Arrangement) = New List(Of Arrangement)

Dim DefArrangementTag As Tag = Nothing
ufs.Assem.AskDefaultArrangement(workPart.Tag, DefArrangementTag)
Dim DefArrangement As Arrangement = Utilities.NXObjectManager.Get(DefArrangementTag)
Dim Resp As MsgBoxResult = Nothing
Resp = MsgBox("Default Arrangement is '" & DefArrangement.Name & _
"' , Press Yes to continue the update or Press No to Exit", vbYesNo, "Default Arrangement")
If Resp = MsgBoxResult.No Then
Exit Sub
ElseIf Resp = MsgBoxResult.Yes Then
'Delete all the existiing Arrangement in workpart
For Each DelArrangment As Arrangement In workPart.ComponentAssembly.Arrangements
If Not DelArrangment.Name = DefArrangement.Name Then
DelArrangementList.Add(DelArrangment)
End If
Next
For i = 0 To DelArrangementList.Count - 1
DelArrangementList(i).Delete(True)
Next
End If

Dim PartClean As PartCleanup
PartClean = theSession.NewPartCleanup()
PartClean.TurnOffHighlighting = True
PartClean.DeleteUnusedObjects = True
PartClean.DeleteUnusedExpressions = True
PartClean.CleanupDraftingObjects = True
PartClean.CleanupFeatureData = True
PartClean.FixOffplaneSketchCurves = True
PartClean.DeleteInvalidAttributes = True
PartClean.CleanupMatingData = True
PartClean.CleanupAssemblyConstraints = True
PartClean.DeleteUnusedFonts = True
PartClean.CleanupCAMObjects = True
PartClean.DeleteBrokenInterpartLinks = True
PartClean.CleanupRoutingData = True
PartClean.CleanupFeatureData = True
PartClean.DeleteVisualEditorData = True
PartClean.DoCleanup()
PartClean.DoCleanup()
PartClean.DoCleanup()
PartClean.Dispose()

'ArrangementOptions.IndividuallyPositioned and Position override for each assemblies
Try
Dim Mycomponent As ComponentAssembly = workPart.ComponentAssembly
UpdateArrangementPosition(Mycomponent.RootComponent, 0)
Catch e As Exception
lw.WriteLine("Assembly component Individually Postitioned Option failed : " & e.ToString)
End Try

Try
Dim Mycomponent As ComponentAssembly = workPart.ComponentAssembly
Dim MyHideList As List(Of Component) = New List(Of Component)
ComponentHide(Mycomponent.RootComponent, 0, MyHideList)
Dim MyHideObj() As DisplayableObject = MyHideList.ToArray
theSession.DisplayManager.BlankObjects(MyHideObj)
workPart.ModelingViews.WorkView.FitAfterShowOrHide(NXOpen.View.ShowOrHideType.HideOnly)
Catch ex As NXException
lw.WriteLine("error 110")
End Try

'Collect all Component group detail and Template coordinate system details
For Each Mygroup As ComponentGroup In workPart.ComponentGroups
If TypeOf Mygroup Is ComponentGroup Then
GroupList.Add(Mygroup)
End If
Next

For Each MyCsys As CoordinateSystem In workPart.CoordinateSystems
If TypeOf MyCsys Is CoordinateSystem Then
If Not MyCsys.Name = "" Then
PrimeCsysList.Add(MyCsys)
End If
End If
Next

'Collect all the Details from Primary CSYS before applying the formula or Else for both Primary and secondary Csys will return the same value
Dim FromOriginX As Double = Nothing
Dim FromOriginY As Double = Nothing
Dim FromOriginZ As Double = Nothing
Dim FromOriginXx As Double = Nothing
Dim FromOriginXy As Double = Nothing
Dim FromOriginXz As Double = Nothing
Dim FromOriginYx As Double = Nothing
Dim FromOriginYy As Double = Nothing
Dim FromOriginYz As Double = Nothing
Dim Xcollection As List(Of Double) = New List(Of Double)
Dim Ycollection As List(Of Double) = New List(Of Double)
Dim Zcollection As List(Of Double) = New List(Of Double)
Dim Xxcollection As List(Of Double) = New List(Of Double)
Dim Xycollection As List(Of Double) = New List(Of Double)
Dim Xzcollection As List(Of Double) = New List(Of Double)
Dim Yxcollection As List(Of Double) = New List(Of Double)
Dim Yycollection As List(Of Double) = New List(Of Double)
Dim Yzcollection As List(Of Double) = New List(Of Double)

For i = 0 To PrimeCsysList.Count - 1
FromOriginX = PrimeCsysList(i).Origin.X
FromOriginY = PrimeCsysList(i).Origin.Y
FromOriginZ = PrimeCsysList(i).Origin.Z
FromOriginXx = PrimeCsysList(i).Orientation.Element.Xx
FromOriginXy = PrimeCsysList(i).Orientation.Element.Xy
FromOriginXz = PrimeCsysList(i).Orientation.Element.Xz
FromOriginYx = PrimeCsysList(i).Orientation.Element.Yx
FromOriginYy = PrimeCsysList(i).Orientation.Element.Yy
FromOriginYz = PrimeCsysList(i).Orientation.Element.Yz
Xcollection.Add(FromOriginX)
Ycollection.Add(FromOriginY)
Zcollection.Add(FromOriginZ)
Xxcollection.Add(FromOriginXx)
Xycollection.Add(FromOriginXy)
Xzcollection.Add(FromOriginXz)
Yxcollection.Add(FromOriginYx)
Yycollection.Add(FromOriginYy)
Yzcollection.Add(FromOriginYz)
Next

' Read expression value from table for each arrangement and update the sketch to move the coordinates and update arrangement
Dim myTabularNoteTags As New List(Of Tag)
If FindTabularNotes(myTabularNoteTags, workPart) = 0 Then
'no tabular notes to process
Return
End If

For Each tableNote As Tag In myTabularNoteTags
ufs.Tabnot.AskNmRows(tableNote, numRows)
ufs.Tabnot.AskNmColumns(tableNote, numCols)
ufs.Tabnot.AskNthRow(tableNote, 0, rowTag)
ufs.Tabnot.AskNthColumn(tableNote, 0, colTag)
ufs.Tabnot.AskCellAtRowCol(rowTag, colTag, cellTag)
ufs.Tabnot.AskCellText(cellTag, Cellvalue)

If Cellvalue = "Arrangements list" Then
ufs.Tabnot.AskNthRow(tableNote, 1, rowTag)
For j = 1 To numCols - 1
ufs.Tabnot.AskNthColumn(tableNote, j, colTag)
ufs.Tabnot.AskCellAtRowCol(rowTag, colTag, cellTag)
ufs.Tabnot.AskCellText(cellTag, Cellvalue)
VariablesTitle.Add(Cellvalue)
Next

For i = 2 To numRows - 1 Step 1
ufs.Tabnot.AskNthRow(tableNote, i, rowTag)
Dim Variables As List(Of String) = New List(Of String)
For j = 0 To numCols - 1
ufs.Tabnot.AskNthColumn(tableNote, j, colTag)
ufs.Tabnot.AskCellAtRowCol(rowTag, colTag, cellTag)
ufs.Tabnot.AskCellText(cellTag, Cellvalue)
Variables.Add(Cellvalue)
Next

ArrangementName = Variables(0)
Dim MyArrangement As Assemblies.Arrangement = Nothing
MyArrangement = workPart.ComponentAssembly.Arrangements.Create(DefArrangement, ArrangementName)
lw.WriteLine("Creating " & ArrangementName.ToString)
MyArrangement.IgnoringConstraints = True
workPart.ComponentAssembly.RootComponent.SetUsedArrangement(MyArrangement)
workPart.ComponentAssembly.ActiveArrangement = MyArrangement
Variables.RemoveAt(0)

For iii As Integer = 0 To Variables.Count - 1
If Variables(iii).ToString = "NA" Then
Variables(iii) = "0"
End If
Next

If VariablesTitle.Count = Variables.Count Then
For k = 0 To VariablesTitle.Count - 1
Try
'This expression will move the base sketch and move the coordinate system to new location
Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Edit Expression")

Dim expression1 As Expression = CType(workPart.Expressions.FindObject(VariablesTitle(k)), Expression)
expression1.RightHandSide = Variables(k)
theSession.Preferences.Modeling.UpdateDelayed = True
theSession.Preferences.Modeling.UpdatePending = True

Dim nErrs1 As Integer
nErrs1 = theSession.UpdateManager.DoUpdate(markId1)

Catch ex As NXException
lw.WriteLine(VariablesTitle(k) & ": " & ex.Message)
End Try

Next

For Each MyCsys As CoordinateSystem In workPart.CoordinateSystems

If TypeOf MyCsys Is CoordinateSystem Then
If Not MyCsys.Name = "" Then
SecondaryCsysList.Add(MyCsys)
End If
End If
Next

For ii = 0 To PrimeCsysList.Count - 1
Dim Movinggroup As ComponentGroup = Nothing
Dim fromCsys As CoordinateSystem = PrimeCsysList(ii)

FromOrigin = {Xcollection(ii), Ycollection(ii), Zcollection(ii)}
FromXAxis = {Xxcollection(ii), Xycollection(ii), Xzcollection(ii)}
FromYAxis = {Yxcollection(ii), Yycollection(ii), Yzcollection(ii)}
'Comparing
Dim toCsys As CoordinateSystem = Nothing
For ij = 0 To SecondaryCsysList.Count - 1
If SecondaryCsysList(ij).Name = fromCsys.Name Then
toCsys = SecondaryCsysList(ij)
End If
Next

Dim toOrigin() As Double = {toCsys.Origin.X, toCsys.Origin.Y, toCsys.Origin.Z}
Dim toXAxis() As Double = {toCsys.Orientation.Element.Xx, toCsys.Orientation.Element.Xy, toCsys.Orientation.Element.Xz}
Dim toYAxis() As Double = {toCsys.Orientation.Element.Yx, toCsys.Orientation.Element.Yy, toCsys.Orientation.Element.Yz}

Dim mtx4Transform(15) As Double

ufs.Mtx4.CsysToCsys(FromOrigin, FromXAxis, FromYAxis, toOrigin, toXAxis, toYAxis, mtx4Transform)

'Extract the rotation matrix and the tranlsation vector
Dim rotMatrix(8) As Double
ufs.Mtx4.AskRotation(mtx4Transform, rotMatrix)
Dim transVec(2) As Double
ufs.Mtx4.AskTranslation(mtx4Transform, transVec)

'Convert array of doubles to vector 3d
Dim translateVector As Vector3d = New Vector3d(transVec(0), transVec(1), transVec(2))
'Convert array of doubles to Matrix3x3
Dim rotationMatrix As Matrix3x3 = convertToMatrix3x3(rotMatrix)

'Find which component group to move based on Primarycsys
Dim Groupobjects() As NXObject = Nothing
Try
For ik = 1 To GroupList.Count - 1
If GroupList(ik).Name = fromCsys.Name Then
Movinggroup = GroupList(ik)
Groupobjects = Movinggroup.GetComponents
'lw.WriteLine(Movinggroup.Name & ": Components Count: " & Groupobjects.Length.ToString)
End If
Next
Catch ex As Exception
lw.WriteLine(ex.Message)
GoTo NextGroup
End Try
Try
'Move groups for each arrangement as per Primary to Secondary Csys move
Dim componentPositioner1 As Positioning.ComponentPositioner
componentPositioner1 = workPart.ComponentAssembly.Positioner
componentPositioner1.ClearNetwork()
componentPositioner1.BeginMoveComponent()
componentPositioner1.PrimaryArrangement() = MyArrangement
Dim allowInterpartPositioning1 As Boolean
allowInterpartPositioning1 = theSession.Preferences.Assemblies.InterpartPositioning
Dim network1 As Positioning.Network
network1 = componentPositioner1.EstablishNetwork()
Dim componentNetwork1 As Positioning.ComponentNetwork = CType(network1, Positioning.ComponentNetwork)
componentNetwork1.NonMovingGroupGrounded = True
componentNetwork1.MoveObjectsState = True
componentNetwork1.RemoveAllConstraints()
componentNetwork1.SetMovingGroup(Groupobjects)
Dim loaded1 As Boolean
loaded1 = componentNetwork1.IsReferencedGeometryLoaded()
componentNetwork1.BeginDrag()
componentNetwork1.DragByTransform(translateVector, rotationMatrix)
componentNetwork1.EndDrag()
componentNetwork1.ResetDisplay()
componentNetwork1.ApplyToModel()
componentNetwork1.Solve()
componentPositioner1.ClearNetwork()
Dim nErrs2 As Integer
nErrs2 = theSession.UpdateManager.AddToDeleteList(componentNetwork1)
componentPositioner1.DeleteNonPersistentConstraints()
componentPositioner1.EndMoveComponent()
Catch ex As NXException
lw.WriteLine(ex.Message)
GoTo NextGroup
End Try
NextGroup:
Next

Else
lw.WriteLine("Table has missing Parameters or Parameter Title count and Value count not matching")
End If
Next

End If
Next

workPart.ComponentAssembly.RootComponent.SetUsedArrangement(DefArrangement)
workPart.ComponentAssembly.ActiveArrangement = DefArrangement

Dim NewArrangementsList As List(Of Arrangement) = New List(Of Arrangement)
For Each NewArrangment As Arrangement In workPart.ComponentAssembly.Arrangements
If Not NewArrangment.Name = DefArrangement.Name Then
NewArrangementsList.Add(NewArrangment)
End If
Next

Try
Dim SuppressGroup As ComponentGroup = CType(workPart.ComponentGroups.FindObject("SUPPRESSED"), ComponentGroup)
Dim ArrangementListForSuppress() As Arrangement = NewArrangementsList.ToArray
Dim errorList1 As ErrorList
errorList1 = workPart.ComponentAssembly.SuppressComponents(SuppressGroup.GetComponents, ArrangementListForSuppress)
errorList1.Dispose()
Catch ex As NXException
lw.WriteLine("Suppress: " & ex.Message)
End Try

Try
Dim Mycomponent As ComponentAssembly = workPart.ComponentAssembly
Dim MyHideList As List(Of Component) = New List(Of Component)
ComponentHide(Mycomponent.RootComponent, 0, MyHideList)
Dim MyHideObj() As DisplayableObject = MyHideList.ToArray
theSession.DisplayManager.UnblankObjects(MyHideObj)
workPart.ModelingViews.WorkView.FitAfterShowOrHide(NXOpen.View.ShowOrHideType.ShowOnly)
Catch ex As NXException
lw.WriteLine("error 366")
End Try

End Sub

Function convertToMatrix3x3(ByVal mtx As Double()) As Matrix3x3
Dim mx As Matrix3x3
With mx
.Xx = mtx(0)
.Xy = mtx(1)
.Xz = mtx(2)
.Yx = mtx(3)
.Yy = mtx(4)
.Yz = mtx(5)
.Zx = mtx(6)
.Zy = mtx(7)
.Zz = mtx(8)
End With

Return mx

End Function
Function FindTabularNotes(ByRef theTabNotes As List(Of Tag), ByVal Mypart As Part) As Integer

Dim tmpTabNote As NXOpen.Tag = NXOpen.Tag.Null
Dim type As Integer
Dim subtype As Integer

Do
ufs.Obj.CycleObjsInPart(Mypart.Tag, UFConstants.UF_tabular_note_type, tmpTabNote)
If tmpTabNote = NXOpen.Tag.Null Then
Continue Do
End If
If tmpTabNote <> NXOpen.Tag.Null Then
ufs.Obj.AskTypeAndSubtype(tmpTabNote, type, subtype)
If subtype = UFConstants.UF_tabular_note_subtype Then
theTabNotes.Add(tmpTabNote)
End If
End If
Loop Until tmpTabNote = NXOpen.Tag.Null
Return theTabNotes.Count

End Function

Sub UpdateArrangementPosition(ByVal comp As Component, ByVal indent As Integer)

For Each child As Component In comp.GetChildren()
If child.GetChildren.Length <> 0 Then
' lw.WriteLine(child.Name)
Try
Dim nullAssemblies_Component As Assemblies.Component = Nothing
child.EstablishPositionOverride(nullAssemblies_Component)
Dim MyObj(0) As NXObject
MyObj(0) = child
Dim assembliesParameterPropertiesBuilder1 As AssembliesParameterPropertiesBuilder = workPart.PropertiesManager.CreateAssembliesParameterPropertiesBuilder(MyObj)
assembliesParameterPropertiesBuilder1.Arrangements = Assemblies.AssembliesParameterPropertiesBuilder.ArrangementOptions.IndividuallyPositioned
Dim NxObject1 As NXObject
NxObject1 = assembliesParameterPropertiesBuilder1.Commit()
assembliesParameterPropertiesBuilder1.Destroy()
Catch ex As NXException
lw.WriteLine("Failed To Position Override")
End Try
Else
Try
Dim nullAssemblies_Component As Assemblies.Component = Nothing
child.EstablishPositionOverride(nullAssemblies_Component)
If Not child.GetPositionOverrideType.ToString() = "Explicit" Then
child.EstablishPositionOverride(nullAssemblies_Component)
End If
Dim MyObj(0) As NXObject
MyObj(0) = child
Dim assembliesParameterPropertiesBuilder1 As AssembliesParameterPropertiesBuilder = workPart.PropertiesManager.CreateAssembliesParameterPropertiesBuilder(MyObj)
assembliesParameterPropertiesBuilder1.Arrangements = Assemblies.AssembliesParameterPropertiesBuilder.ArrangementOptions.IndividuallyPositioned
Dim NxObject1 As NXObject
NxObject1 = assembliesParameterPropertiesBuilder1.Commit()
assembliesParameterPropertiesBuilder1.Destroy()
Catch ex As NXException
lw.WriteLine("Failed To Position Override")
End Try
End If
UpdateArrangementPosition(child, indent + 1)
Next
End Sub

Sub ComponentHide(ByVal comp As Component, ByVal indent As Integer, ByRef Hidelist As List(Of Component))

For Each child As Component In comp.GetChildren()
If child.GetChildren.Length <> 0 Then
' lw.WriteLine(child.Name)
Try
Hidelist.Add(child)
Catch ex As NXException
End Try
Else
Try
Hidelist.Add(child)
Catch ex As NXException
End Try
End If
ComponentHide(child, indent + 1, Hidelist)
Next
End Sub

Public Function GetUnloadOption(ByVal dummy As String) As Integer

'Unloads the image immediately after execution within NX
GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately

End Function
End Module