Continue to Site

Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

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

how to avoid popup

Status
Not open for further replies.

DesEngineer4

Mechanical
Feb 19, 2013
181
HI
I am using the below journal to move objects and assembly components to respective layers. And this journal is combined with objects and assembly components.

If a part does not have any assembly components means, it is showing an pop up box that there is no assembly components. Can you help me in avoiding that popup...



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 = 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

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







Thanks & Regards,
Sam
 
Replies continue below

Recommended for you

Hi cowski,

I want to merge this code to other journals which i am using..How to do this ?

It is enough to ask "Yes or No" no need to open any listing window..Please give me the code for this, so that i will merge with other journal codes.

Code:
Option Strict Off
Imports System
Imports NXOpen
Imports NXOpenUI
 
Module Module1
 
    Sub Main()
 
        Dim theSession As Session = Session.GetSession()
		Dim lw as ListingWindow = theSession.ListingWindow
        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"
        End If
		
		lw.WriteLine("user answered: " & answer)
  
 
    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
 
Yeah I tried,

But, it is showing an error like "declaration expected".

Thanks & Regards,
Sam
 
I tried in this way:



Dim theUISession As UI = UI.GetUI
Dim response As Integer
Dim answer As String = ""



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"

Else
'code to run in response to "no" answer
answer = "No"
End If


Thanks & Regards,
Sam
 
Is that your entire journal?
If so, at a minimum, you'll need to add the imports statements, the module declaration (and end module), and the Sub Main/End Sub statements.

i.e. take the code from your post of 8 May 13 6:03, and delete the 4 lines that reference the "lw" object.

www.nxjournaling.com
 
Yeah, it is working now.

But, Journal is running even if we click on answer "no". It should exit or to stop running journal when we click on "no". Please suggest how to proceed that.

Thanks & Regards,
Sam
 
Code:
If response = 1 Then
'code to run in response to "yes" answer
answer = "Yes"

Else
'code to run in response to "no" answer
answer = "No"
[highlight #FCE94F]Exit Sub[/highlight]
End If

The exit sub statement will exit whatever subroutine it is called from. If you are in Sub Main (as in your example) it will exit the journal entirely.

www.nxjournaling.com
 
Hi Cowski,


This is the Entire Code for journal:

after running this code, If we click on undo button, it is not coming to the previous state. Why ?
What changes to be done to avoid it.


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 >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
            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
                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
 
If you want to undo the actions of the journal, you will need to set an undo mark at the desired location. Add the following code before your journal starts moving stuff.

Code:
Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Move object layers")

www.nxjournaling.com
 
Hi cowski,

Can you tell me what type of skills are required for customization of NX.

Thanks & Regards,
Sam
 
Hi cowski,

This is another issue..
The below journal made by us with many trail and errors, by picking one sample vb program from GTAC Solution centre.

As, I already posted with thread name like "Pick a point"(
As of know this journal is asking to pick a point in the form of dialog box. But, it is not showing any message like pick a point or specify the point.
Another issue is, this dialogue box have two options like ok and cancel. Even if we click on cancel it is importing the label at origin of drawing sheet.

Please correct the journal in the following ways:

1. we need a message in that dialogue box like "specify a point"
2. if we click on the cancel button it should not import the label
3. If the user executed unfortunately again the same journal it should show some message like already exists. This is just to avoid multiple imports.

Code:
Option Strict Off
Imports System
Imports System.Windows.Forms

Imports NXOpen
Imports NXOpen.UF
Imports NXOpen.UI
Imports NXOpen.Utilities

Module NXJournal
    Dim theSession As Session = Session.GetSession()
    Dim ufs As UFSession = UFSession.GetUFSession()

    Sub Main()

        Dim screenPosition As Point3d

        Dim workPart As Part = theSession.Parts.Work

        Dim displayPart As Part = theSession.Parts.Display

        ' ----------------------------------------------
        '   Menu: File->Import->Part...
        ' ----------------------------------------------
        Dim markId1 As Session.UndoMarkId
        markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Import Part")

        Dim importer1 As Importer
        importer1 = workPart.ImportManager.CreatePartImporter()

        Dim partImporter1 As PartImporter = CType(importer1, PartImporter)

        partImporter1.FileName = "D:\Lean\sample.prt"

        partImporter1.Scale = 1.0

        partImporter1.CreateNamedGroup = False

        partImporter1.ImportViews = False

        partImporter1.ImportCamObjects = False

        partImporter1.LayerOption = PartImporter.LayerOptionType.Work

        partImporter1.DestinationCoordinateSystemSpecification = PartImporter.DestinationCoordinateSystemSpecificationType.Work

        Dim element1 As Matrix3x3
        element1.Xx = 1.0
        element1.Xy = 0.0
        element1.Xz = 0.0
        element1.Yx = 0.0
        element1.Yy = 1.0
        element1.Yz = 0.0
        element1.Zx = 0.0
        element1.Zy = 0.0
        element1.Zz = 1.0
        Dim nXMatrix1 As NXMatrix
        nXMatrix1 = workPart.NXMatrices.Create(element1)

        partImporter1.DestinationCoordinateSystem = nXMatrix1

        SelectPoint(screenPosition)

        Dim destinationPoint1 As Point3d = New Point3d(screenPosition.X, screenPosition.Y, screenPosition.Z)
        partImporter1.DestinationPoint = destinationPoint1

        Dim markId2 As Session.UndoMarkId
        markId2 = theSession.SetUndoMark(Session.MarkVisibility.Invisible, "Import Part Commit")

        Dim nXObject1 As NXObject
        nXObject1 = partImporter1.Commit()

        theSession.DeleteUndoMark(markId2, Nothing)

        partImporter1.Destroy()

    End Sub
    Function SelectPoint(ByRef screenpos As Point3d) As Selection.Response
        Dim view_tag As NXOpen.Tag
        Dim point(2) As Double
        Dim response As Integer
        ufs.Ui.LockUgAccess(NXOpen.UF.UFConstants.UF_UI_FROM_CUSTOM)

        Try

            ufs.Ui.SpecifyScreenPosition("Select location for new note", _
                               Nothing, IntPtr.Zero, point, view_tag, response)
        Finally
            ufs.Ui.UnlockUgAccess(NXOpen.UF.UFConstants.UF_UI_FROM_CUSTOM)
        End Try


        If response <> NXOpen.UF.UFConstants.UF_UI_PICK_RESPONSE Then _
                                              Return Selection.Response.Cancel
        screenpos.X = point(0)
        screenpos.Y = point(1)
        screenpos.Z = point(2)

        Dim viewTag As NXOpen.Tag = theSession.Parts.Work.Views.WorkView.Tag
        Dim myColor As UFObj.DispProps
        myColor.color = 186

        ufs.Disp.DisplayTemporaryPoint(viewTag, UFDisp.ViewType.UseCursor, _
                              point, myColor, UFDisp.PolyMarker.Asterisk)

        Return Selection.Response.Ok

    End Function

End Module

Thanks & Regards,
Sam
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor