Continue to Site

Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations waross on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

Error after running journal..

Status
Not open for further replies.

DesEngineer4

Mechanical
Feb 19, 2013
181
Hi all,

Can any one help me on the following issue..

I am using the below journal in moving the features and lines and arcs and components...etc to respective layers. This journal is working very fine in respective of moving those objects to specified layers...But, after completing the action of journal the hidden datum's and csys`s are coming out...I have attached the snap shots of the model, how it looks after running the journal....

Please help me..
Thanks in Advance..


Code:
Option Strict Off  
Imports System  
Imports System.Collections  
Imports NXOpen  
Imports NXOpen.UF  
Imports NXOpen.Utilities  
Imports NXOpen.Assemblies  
Imports NXOpen.Features

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 = 90  
        Dim linelayer As Integer = 90  
        Dim arclayer As Integer = 90  
        Dim coniclayer As Integer = 90  
        Dim splinelayer As Integer = 90  
        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 >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 <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  
     
	'move symbolic thread arcs to layer 1
	For each myFeature as Feature in workPart.Features  
	    if myFeature.FeatureType = "SYMBOLIC_THREAD" then  
	        for each myEnt as arc in myFeature.GetEntities  
		    myEnt.Layer = 1  
		    myEnt.RedisplayObject  
		next  
	    end if  
	Next  

        Dim root As Component = s.Parts.Display.ComponentAssembly.RootComponent  
		If Not IsNothing(root) Then  
			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

Thanks & Regards,
Sam
 
Replies continue below

Recommended for you

Hi cowski,

For child parts it is working..
And,

From the code for layers which you responded on 9 May 13 8:49

I want to add a loop for every curve geometry not to touch the layers which are in between 240 to 256.

How can i do this..Please advice...

Thanks & Regards,
Sam
 
You can add an additional check to the object's current layer before you move it. Perhaps something like:

Code:
If linecol.ToArray().Length > 0 Then
  For Each ln As Line In linecol
    [highlight #FCE94F]If ln.Layer < 240 Then[/highlight]
      If (ln.Layer > 79 Or ln.Layer < 60) Then
        ufs.Obj.SetLayer(ln.Tag, linelayer)
      End If
    [highlight #FCE94F]End If[/highlight]
  Next
End If

Any lines on layer 240 or above will be ignored.

www.nxjournaling.com
 
Hi cowski,

This is new issue on layers journal..

Till now we have not implemented and coding for artwork and trammel points. Generally we will move those artwork to 230 layer and trammel points to 231 layer. If there are many artworks in one drawing..then we move alternative layers. eg: artwork 1 to 230, artwork 1 trammel points to 231 and similarly artwork 2 to 232 and artwork 2 trammel points to 233. So, my question is, whether it is possible to move those artwork to respective layers using journal?

Please advice us.



Thanks & Regards,
Sam
 
What exactly is this artwork? Imported raster images? sketches? dumb curves?

Assuming it is dumb curves (lines, arcs, splines, etc like those from an imported dxf file), you will need some way to distinguish the artwork vs. other curves. One way to do this is with named groups. The journal could then look for these artwork groups and move the group (objects and all) to the specified layer.

www.nxjournaling.com
 
Thanks for your reply,

Artwork is something like to show on the part after manufacturing. It may be a text or labels or anything.

I will upload the sample artwork shortly.
Please see the part

There you can find two things.

1. The outer boundary we call as trammel points which import them as a part.
2. The text which we call as artwork and it should be shown on the model after manufacturing.


Thanks & Regards,
Sam
 
Hi cowski,

If you not understand my need on our previous conversation. Please let me know I will try to explain you in different.

Thanks & Regards,
Sam
 
Hi cowski,

Please forget about artwork which was posted in our previous conversation for time being.
The below code is our final journal to use for layers. But, we have some issues in it.

1. The first coordinate system in the part navigator is moving to layer 61 and remaining datum axiss is moving to layer 40 only.
2. Symbolic thread is also moving to layer 61. But, after changing the window, again it is coming back to layer 1.
3. By executing this journal multiple times on the same model or part. Datum planes and datum axis are moving to layer 61. Not only datum's even some features also moving to layers 61 or 1.
4. As we coded in to move saved csys to 100. If we save csys at any location that csys is moving to layer 100 and some reference lines are creating through default datum axis(for this issue please see attachment)



We hope, you can treat this as high priority.


Code:
Option Strict Off
Imports System
Imports System.Collections
Imports NXOpen
Imports NXOpen.UF
Imports NXOpen.Utilities
Imports NXOpen.Assemblies
Imports NXOpen.Features
Imports NXOpenUI

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 theUISession As UI = UI.GetUI
	Dim response As Integer
        Dim answer As String = "" 

		lw.Open
 
        response = theUISession.NXMessageBox.Show("Question", NXMessageBox.DialogType.Question, "Move objects to layer?")
        '1 = Yes
        '2 = No
 
        If response = 1 Then
			'code to run in response to "yes" answer
            answer = "Yes"
			lw.WriteLine("moving objects from layer X to layer Y...")
        Else
			'code to run in response to "no" answer
            answer = "No"
       Exit Sub
       End If
		
		lw.WriteLine("user answered: " & answer)
          

        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 = 100
        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 < 240 Then
                If ((ln.Layer >79 or ln.Layer <60) and (ln.Layer >256 or ln.Layer <241) and ln.Layer >1 and (ln.layer >199 or ln.layer <80))
                ufs.Obj.SetLayer(ln.Tag, linelayer)
	      	End If
	      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 and (arc1.layer >199 or arc1.layer <80))
                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 and (sp.layer >199 or sp.layer <80))
                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 and (sb.layer >199 or sb.layer <80)) 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

                Dim junk As DatumPlane = obj
                If junk.Feature.FeatureType.ToString = "DATUM_PLANE" Then
                    Try
                        Dim parentFeat As Features.Feature() = junk.Feature.GetParents
                        If parentFeat(0).GetFeatureName.Contains(" ") Then
                            Continue For
                        End If
                    Catch ex As Exception

                    End Try
                End If


                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) and (sk.layer >199 or sk.layer <80))
                ufs.Obj.SetLayer(sk.Tag, sketchlayer)
             End If
		sk.Activate(False)
		sk.UpdateGeometryDisplay()
		sk.Deactivate(False, Sketch.UpdateLevel.SketchOnly)
            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

        'move symbolic thread arcs to layer 1
	For each myFeature as Feature in workPart.Features  
	    if myFeature.FeatureType = "SYMBOLIC_THREAD" then  
	        for each myEnt as arc in myFeature.GetEntities  
		    myEnt.Layer = 1  
		    myEnt.RedisplayObject  
		next  
	    end if  
	Next
   
        Dim root As Component = s.Parts.Display.ComponentAssembly.RootComponent
        If Not IsNothing(root) Then
        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 and (objlayer >199 or objlayer <80))  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 when the NX session terminates
        GetUnloadOption = NXOpen.Session.LibraryUnloadOption.AtTermination
 
    End Function
 
End Module

Thanks & Regards,
Sam
 
 http://files.engineering.com/getfile.aspx?folder=42820a34-39a7-4031-b0a8-35a12adfd141&file=Capture.JPG
I'll give you a hint.
The csys in the attached picture didn't move because of this line of code:

Code:
If parentFeat(0).GetFeatureName.Contains(" ") Then

The parent feature name of the datum planes is "Datum Coordinate System". Notice the spaces in the parent feature name. The code in the if block skips the rest of the entities, leaving the csys behind.

www.nxjournaling.com
 
OKAY.
What code to be inserted in this journal to avoid that...

Thanks & Regards,
Sam
 
There are multiple strategies that would work...
add an additional conditional test on the parent feature name, or
use elseif statements or a select case block to test for different feature names, or
.
.
.

www.nxjournaling.com
 
If you are free.

Please give me the code.
I dont know anything about nx journal.

Thanks & Regards,
Sam
 
Hi cowski,

Can you give me the code for layers

Thanks & Regards,
Sam
 
HI COWSKI,

Please try to give me the code. If you have a free time.

Thanks & Regards,
Sam
 
Ok, I found a method that works.

Code:
Option Strict Off
Imports System
Imports System.Collections
Imports NXOpen
Imports NXOpen.UF
Imports NXOpen.Utilities
Imports NXOpen.Assemblies
Imports NXOpen.Features
Imports NXOpenUI

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 theUISession As UI = UI.GetUI
	Dim response As Integer
        Dim answer As String = "" 

		lw.Open
 
        response = theUISession.NXMessageBox.Show("Question", NXMessageBox.DialogType.Question, "Move objects to layer?")
        '1 = Yes
        '2 = No
 
        If response = 1 Then
			'code to run in response to "yes" answer
            answer = "Yes"
			lw.WriteLine("moving objects from layer X to layer Y...")
        Else
			'code to run in response to "no" answer
            answer = "No"
       Exit Sub
       End If
		
		lw.WriteLine("user answered: " & answer)
          

        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 = 100
        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 < 240 Then
                If ((ln.Layer >79 or ln.Layer <60) and (ln.Layer >256 or ln.Layer <241) and ln.Layer >1 and (ln.layer >199 or ln.layer <80))
                ufs.Obj.SetLayer(ln.Tag, linelayer)
	      	End If
	      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 and (arc1.layer >199 or arc1.layer <80))
                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 and (sp.layer >199 or sp.layer <80))
                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 and (sb.layer >199 or sb.layer <80)) 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

                Dim junk As DatumPlane = obj
                If junk.Feature.FeatureType.ToString = "DATUM_PLANE" Then
                    Try
                        Dim parentFeat As Features.Feature() = junk.Feature.GetParents
                        If parentFeat(0).GetFeatureName.Contains(" ") Then
                            Continue For
                        End If
                    Catch ex As Exception

                    End Try
                End If


                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) and (sk.layer >199 or sk.layer <80))
                ufs.Obj.SetLayer(sk.Tag, sketchlayer)
             End If
		sk.Activate(False)
		sk.UpdateGeometryDisplay()
		sk.Deactivate(False, Sketch.UpdateLevel.SketchOnly)
            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

        'move symbolic thread arcs to layer 1
	For each myFeature as Feature in workPart.Features  
	    if myFeature.FeatureType = "SYMBOLIC_THREAD" then  
	        for each myEnt as arc in myFeature.GetEntities  
		    myEnt.Layer = 1  
		    myEnt.RedisplayObject  
		next  
	    end if
		
		If (myFeature.FeatureType = "DATUM_CSYS") AndAlso (Not myFeature.IsInternal) Then
			Dim DBuilder As DatumCsysBuilder
			DBuilder = workPart.Features.CreateDatumCsysBuilder(myFeature)
			Dim DCObj() As NXObject = DBuilder.GetCommittedObjects
		
			For Each temp As DisplayableObject In DCObj
			temp.Layer = dplanelayer
			temp.RedisplayObject()
			Next
			DBuilder.Destroy()
		
			Dim updateMark As Session.UndoMarkId
			updateMark = s.SetUndoMark(Session.MarkVisibility.Invisible, "update")
			Try
				s.UpdateManager.LogForUpdate(myFeature)
				s.UpdateManager.DoUpdate(updateMark)
			Catch ex As Exception
		
			End Try
		
		End If

	Next
   
        Dim root As Component = s.Parts.Display.ComponentAssembly.RootComponent
        If Not IsNothing(root) Then
        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 and (objlayer >199 or objlayer <80))  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 when the NX session terminates
        GetUnloadOption = NXOpen.Session.LibraryUnloadOption.AtTermination
 
    End Function
 
End Module

www.nxjournaling.com
 
Thank you very much for your response Cowski,

I will try this code and let you know the results.

Thanks & Regards,
Sam
 
HI COWSKI,

THANK YOU VERY MUCH. THIS CODE IS WORKING FINE.

Symbolic thread is moving to layer 1 only but it is showing as it is in layer 61.

Thanks & Regards,
Sam
 
Update for symbolic thread.

Code:
Option Strict Off
Imports System
Imports System.Collections
Imports NXOpen
Imports NXOpen.UF
Imports NXOpen.Utilities
Imports NXOpen.Assemblies
Imports NXOpen.Features
Imports NXOpenUI

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 theUISession As UI = UI.GetUI
	Dim response As Integer
        Dim answer As String = "" 

		lw.Open
 
        response = theUISession.NXMessageBox.Show("Question", NXMessageBox.DialogType.Question, "Move objects to layer?")
        '1 = Yes
        '2 = No
 
        If response = 1 Then
			'code to run in response to "yes" answer
            answer = "Yes"
			lw.WriteLine("moving objects from layer X to layer Y...")
        Else
			'code to run in response to "no" answer
            answer = "No"
       Exit Sub
       End If
		
		lw.WriteLine("user answered: " & answer)
          

        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 = 100
        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 < 240 Then
                If ((ln.Layer >79 or ln.Layer <60) and (ln.Layer >256 or ln.Layer <241) and ln.Layer >1 and (ln.layer >199 or ln.layer <80))
                ufs.Obj.SetLayer(ln.Tag, linelayer)
	      	End If
	      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 and (arc1.layer >199 or arc1.layer <80))
                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 and (sp.layer >199 or sp.layer <80))
                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 and (sb.layer >199 or sb.layer <80)) 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

                Dim junk As DatumPlane = obj
                If junk.Feature.FeatureType.ToString = "DATUM_PLANE" Then
                    Try
                        Dim parentFeat As Features.Feature() = junk.Feature.GetParents
                        If parentFeat(0).GetFeatureName.Contains(" ") Then
                            Continue For
                        End If
                    Catch ex As Exception

                    End Try
                End If


                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) and (sk.layer >199 or sk.layer <80))
                ufs.Obj.SetLayer(sk.Tag, sketchlayer)
             End If
		sk.Activate(False)
		sk.UpdateGeometryDisplay()
		sk.Deactivate(False, Sketch.UpdateLevel.SketchOnly)
            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

        'move symbolic thread arcs to layer 1
        For Each myFeature As Feature In workPart.Features
            If myFeature.FeatureType = "SYMBOLIC_THREAD" Then
                For Each myEnt As arc In myFeature.GetEntities
                    myEnt.Layer = 1
                    myEnt.RedisplayObject()

                    Dim updateMark As Session.UndoMarkId
                    updateMark = s.SetUndoMark(Session.MarkVisibility.Invisible, "update")
                    Try
                        s.UpdateManager.LogForUpdate(myFeature)
                        s.UpdateManager.DoUpdate(updateMark)
                    Catch ex As Exception

                    End Try

                Next
            End If

            If (myFeature.FeatureType = "DATUM_CSYS") AndAlso (Not myFeature.IsInternal) Then
                Dim DBuilder As DatumCsysBuilder
                DBuilder = workPart.Features.CreateDatumCsysBuilder(myFeature)
                Dim DCObj() As NXObject = DBuilder.GetCommittedObjects

                For Each temp As DisplayableObject In DCObj
                    temp.Layer = dplanelayer
                    temp.RedisplayObject()
                Next
                DBuilder.Destroy()

                Dim updateMark As Session.UndoMarkId
                updateMark = s.SetUndoMark(Session.MarkVisibility.Invisible, "update")
                Try
                    s.UpdateManager.LogForUpdate(myFeature)
                    s.UpdateManager.DoUpdate(updateMark)
                Catch ex As Exception

                End Try

            End If

        Next
   
        Dim root As Component = s.Parts.Display.ComponentAssembly.RootComponent
        If Not IsNothing(root) Then
        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 and (objlayer >199 or objlayer <80))  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 when the NX session terminates
        GetUnloadOption = NXOpen.Session.LibraryUnloadOption.AtTermination
 
    End Function
 
End Module

www.nxjournaling.com
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor