Moving objects and components to layers using journal

[Pravi6]

Hi Frank,

I am using a journal to move the objects and assembly components to layers which was given by you. Really it is working very nice. But, i am facing a small problem with this journal. When i am trying to run this journal in my part file which consists of only objects (lines, sketches, splines and extruded bodies) and doesn't have any assembly components, it is showing an error in a pop up window mentioning that the part file doesn't have any assembly components. Please help me in fixing this issue. Below is the journal which i am using right now.


Option Strict Off
Imports System
Imports System.Collections
Imports NXOpen
Imports NXOpen.UF
Imports NXOpen.Utilities
Imports NXOpen.Assemblies

Module layermove

Sub Main()

Dim s As Session = Session.GetSession()
Dim lw As ListingWindow = s.ListingWindow
Dim ufs As UFSession = UFSession.GetUFSession()
Dim workPart As Part = s.Parts.Work

Dim displaypart As Part = s.Parts.Display

Dim pointcol As PointCollection = workPart.Points
Dim linecol As LineCollection = workPart.Lines
Dim arccol As ArcCollection = workPart.Arcs
Dim splinecol As SplineCollection = workPart.Splines
Dim sketchcol As SketchCollection = workpart.Sketches
Dim bodycol As BodyCollection = workpart.Bodies
Dim allComp1 As ArrayList = New ArrayList

Dim objArray(0) As DisplayableObject

Dim pointslayer As Integer = 61
Dim linelayer As Integer = 61
Dim arclayer As Integer = 61
Dim coniclayer As Integer = 61
Dim splinelayer As Integer = 61
Dim csyslayer As Integer = 40
Dim daxislayer As Integer = 40
Dim dplanelayer As Integer = 40
Dim bodylayer As Integer = 1
Dim sketchlayer As Integer = 20

If pointcol.ToArray().Length > 0 Then
For Each pt As Point In pointcol
If (pt.Layer >79 or pt.Layer <60)
ufs.Obj.SetLayer(pt.Tag, pointslayer)
End If
Next
End If

If linecol.ToArray().Length > 0 Then
For Each ln As Line In linecol
If ((ln.Layer >79 or ln.Layer <60) and (ln.Layer >256 or ln.Layer <241) and ln.Layer >1)
ufs.Obj.SetLayer(ln.Tag, linelayer)
End If
Next
End If

If arccol.ToArray().Length > 0 Then
For Each arc1 As Arc In arccol
If (arc1.Layer >79 or arc1.Layer <60)
ufs.Obj.SetLayer(arc1.Tag, arclayer)
End If
Next
End If

If splinecol.ToArray().Length > 0 Then
For Each sp As Spline In splinecol
If (sp.Layer >79 or sp.Layer <60)
ufs.Obj.SetLayer(sp.Tag, splinelayer)
End If
Next
End If

If bodycol.ToArray().Length > 0 Then
For Each sb As Body In bodycol
If sb.Layer >19 Then
ufs.Obj.SetLayer(sb.Tag,bodylayer)
End If
Next
End If


For Each obj As DisplayableObject In workPart.Datums
If TypeOf obj Is DatumPlane Then
objArray(0) = obj
workPart.Layers.MoveDisplayableObjects(dplanelayer, objArray)
End If

If TypeOf obj Is DatumAxis Then
objArray(0) = obj
workPart.Layers.MoveDisplayableObjects(daxislayer, objArray)
End If
Next

If sketchcol.ToArray().Length > 0 Then
For Each sk As Sketch In sketchcol
If (sk.Layer >39 or sk.Layer <20)
ufs.Obj.SetLayer(sk.Tag, sketchlayer)
End If
Next
End If

Dim coniccol(-1) As Tag
Dim conictype As Integer = 6
Dim conictag As Tag = Tag.Null
Dim count As Integer = 0

ufs.Obj.CycleObjsInPart(workPart.Tag, conictype, conictag)
While conictag <> Tag.Null
ReDim Preserve coniccol(count)
coniccol(count) = conictag
count += 1
ufs.Obj.CycleObjsInPart(workPart.Tag, conictype, conictag)
End While


If coniccol.Length > 0 Then
For i As Integer = 0 To coniccol.Length - 1
ufs.Obj.SetLayer(coniccol(i), coniclayer)
Next
End If

Dim csyscol(-1) As Tag
Dim csystype As Integer = 45

Dim csystag As NXOpen.Tag = Tag.Null
count = 0

ufs.Obj.CycleObjsInPart(workPart.Tag, csystype, csystag)
While csystag <> Tag.Null
ReDim Preserve csyscol(count)
csyscol(count) = csystag
count += 1
ufs.Obj.CycleObjsInPart(workPart.Tag, csystype, csystag)
End While
If csyscol.Length > 0 Then
For i As Integer = 0 To csyscol.Length - 1
ufs.Obj.SetLayer(csyscol(i), csyslayer)
Next
End If

Dim root As Component = s.Parts.Display.ComponentAssembly.RootComponent
getAllComponents2(root, allComp1)
Dim dispobj As DisplayableObject = Nothing
Dim cnt1 As Integer = allComp1.Count
Dim objectArray1(cnt1 - 1) As DisplayableObject
Dim objlayer As Integer = Nothing
Dim cnt2 As Integer = 0
For i As Integer = 0 To cnt1 - 1
dispobj = DirectCast(allComp1(i), DisplayableObject)
objlayer = dispobj.Layer
If objlayer > 19 Then
ReDim Preserve objectArray1(cnt2)
objectArray1(cnt2) = allComp1(i)
cnt2 += 1
End If
Next
If cnt2 > 0 Then
displaypart.Layers.MoveDisplayableObjects(1, objectArray1)
End If

End Sub

Sub getAllComponents2(ByVal comp As Component, ByRef allComp As ArrayList)
Dim child As Component = Nothing
Dim space As String = Nothing
For Each child In comp.GetChildren()
allComp.Add(child)
getAllComponents2(child, allComp)
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


________________________________________________________________________________________________________________________

Thanks in Advance

Regards,
Praveen