×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

moving objects and assembly components to layers using journal

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

RE: moving objects and assembly components to layers using journal

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

RE: moving objects and assembly components to layers using journal

(OP)
Thank you, its working

RE: moving objects and assembly components to layers using journal

(OP)

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

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources