moving objects and assembly components to layers using journal
moving objects and assembly components to layers using journal
(OP)
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
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





RE: moving objects and assembly components to layers using journal
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
RE: moving objects and assembly components to layers using journal
RE: moving objects and assembly components to layers using journal
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