moving objects and assembly components to layers using journal 1

[DesEngineer4]

Hi
I am using below journal to move objects and assembly components to certain layers using below journal. And it is working fine. But, I have a problem If the part does not contain any assembly components means then it was showing a pop up like there is no components. Can any body help me in resolving the issue.

My need: It should not show any pop up messages if there is no assembly components. Please guide me.




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 = 55
Dim linelayer As Integer = 55
Dim arclayer As Integer = 55
Dim coniclayer As Integer = 55
Dim splinelayer As Integer = 55
Dim csyslayer As Integer = 40
Dim daxislayer As Integer = 40
Dim dplanelayer As Integer = 40
Dim bodylayer As Integer = 1
Dim sketchlayer As Integer = 40

If pointcol.ToArray().Length > 0 Then
For Each pt As Point In pointcol
If (pt.Layer >69 or pt.Layer <50)
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 >69 or ln.Layer <50)
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 >69 or arc1.Layer <50)
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 >69 or sp.Layer <50)
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 >49 or sk.Layer <40)
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

If allcomp1.ToArray().Length > 0 Then
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 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


Regards,

Sam

 

[FrankSwinks]

You check for the components in the array before you fill the array with the components. That is

If allcomp1.ToArray().Length > 0 Then

is called before

getAllComponents2(root, allComp1)

you will never have any components in the array.

Just arrange the code as

Dim root As Component = s.Parts.Display.ComponentAssembly.RootComponent
getAllComponents2(root, allComp1)
Dim dispobj As DisplayableObject = Nothing
Dim cnt1 As Integer = allComp1.Count
If cnt1 > 0 Then
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 If


Frank Swinkels

 

[DesEngineer4]

Thank you, its working

 

[DesEngineer4]

I want your help on below requirement. please help me.

Regarding assembly reference set. I need the changes to the below journal. Instead of replacing reference set Entire part to some other reference set. can we do the modifications to this journal. so, that what ever default reference set it may contain to the assyembly components, all components should move automatically to one reference set (example: say "Toplevel") with single click.



Option Strict Off

Imports System
Imports System.Collections
Imports NXOpen
Imports NXOpen.Assemblies
Imports NXOpen.UF

Module ReportReferenceSet

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

Sub Main()
Dim allComp1 As ArrayList = New ArrayList
' lw.Open()
Dim root As Component = s.Parts.Display.ComponentAssembly.RootComponent
getAllComponents2(root, allComp1)
Dim referenceSet1 As String = "Entire Part"
Dim referenceSet2 As String = "S"
' reportComponentReferenceSet(allComp1, referenceSet1)
ChangeComponentReferenceSet(allComp1, referenceSet1, referenceSet2)
End Sub
Sub reportComponentReferenceSet(ByVal allComp1 As ArrayList, ByVal referenceSet1 As String)
For Each comp As Component In allComp1
If comp.ReferenceSet = referenceSet1 Then
lw.WriteLine(comp.Name & " " & comp.ReferenceSet)
End If
Next
End Sub
Sub ChangeComponentReferenceSet(ByVal allComp1 As ArrayList, ByVal referenceSet1 As String, _
ByVal referenceSet2 As String)
Dim errorList1 As ErrorList
Dim comp1(0) As Component
For Each comp As Component In allComp1

If comp.ReferenceSet = referenceSet1 Then
comp1(0) = comp
errorList1 = displaypart.ComponentAssembly.ReplaceReferenceSetInOwners(referenceSet2, comp1)
End If
Next
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
Return Session.LibraryUnloadOption.Immediately
End Function

End Module



Regards,
Sam