Selective save as in vb

[PSI-CAD]

Hi,

I have a journal that save as all part with a given suffix in NX11. (I can't use clone because some parts are family members !!!)

Now, I would like to perform a specific save as for a list of component and maye the list could be set in Excel with export ANT to spreadsheet

and for all renamed part all upper levels must be renamed automatically like the following example

Is it easy to do the job ? and does anybody can help me ?

Thanks in advance



Regards
Didier Psaltopoulos

http://www.psi-cad.fr

 

[PSI-CAD]

Hi,

Pending an answer, I continued and I found the following idea to avoid using spreadsheet by using an attribut save_as.

I also added a button when a component is selected and I need a journal to save as the selected component with a specific suffix which is another attribut

Thanks in advance for your help

Regards
Didier Psaltopoulos

http://www.psi-cad.fr

 

[Ehaviv]

Hi I wrote this journal a long ago for NX MANAGED
and its work for me.

It is build by combine recording code and code from the internet.

Maybe you can use this code to write your journal for NX NATIVE

Option Strict Off
Imports System
Imports System.IO
Imports NXOpen
Imports NXOpen.UF
Imports NXOpen.Utilities
Imports NXOpenUI.NXInputBox

Module nxm_assembly_cloning_by_save_as

 Dim theUI As UI = UI.GetUI()

 Sub Main (ByVal args() As String)

  Dim s As Session = Session.GetSession()
  Dim ufs As UFSession = UFSession.GetUFSession
  Dim theUI As UI = UI.GetUI()
  Dim lw As ListingWindow = s.ListingWindow
  Dim display_part As Part = s.Parts.Display
  Dim work_part As Part = s.Parts.Work
 
  Dim windir As String
  Dim sw As New StringWriter()
  Dim prefix As String = "a1_"
  Dim pn(-1) As String
  Dim rn(-1) As String
  Dim pdm(-1) As String
  Dim counter As Integer = -1
  Dim objs() As NXObject = Nothing
  Dim n_objs As Integer = 0
  Dim aComp As Assemblies.Component = Nothing
  Dim partName As String = ""
  Dim dTitle As String
  Dim dMessage As String
  Dim prt_name As String
  Dim prt_cnt As Integer = 1
  Dim n1,n2 As Integer
  Dim display_part_dir As String
  Dim partNumber As String = ""
  Dim partRevision As String = ""
  Dim partFileType As String = ""
  Dim partFileName As String = ""
  Dim assemblyToClone As String
  Dim folder_name As String
  Dim item_type As String 
  Dim action_type As UFClone.Action
  Dim componentx(-1) As Assemblies.Component
  Dim part_num As String 
  Dim part_rev As String 

  lw.Open()
  ufs.Ui.ExitListingWindow()

  prefix = GetInputString("Assembly cloning  :  Enter  prefix string", _
                                             "pany  :  dev name", "a1_")
  If work_part.Equals(display_part) Then
    'ok
  Else
    MsgBox("Display Part and Work Part must be the same")
    Exit Sub
  End If

  Dim date_time As DateTime = System.DateTime.Now()
  Dim datetime_str as String() = date_time.GetDateTimeFormats()
  'Original ==> datetime_str(35)  =  21/07/2016 16:12
  datetime_str(35) = datetime_str(35).RePlace("/", "")
  datetime_str(35) = datetime_str(35).RePlace(":", "")
  datetime_str(35) = ":Backup SaveAs " & datetime_str(35)
  'Changed To ==> datetime_str(35)  =  :Backup SaveAs 21072016 1612
  sw.WriteLine("datetime_str(35) = " & datetime_str(35))

  assemblyToClone = "@DB/" & display_part.FullPath
  sw.WriteLine("assemblyToClone  =  " & assemblyToClone)
 
  ufs.Part.AskPartName(display_part.Tag, partName)
  ufs.Ugmgr.DecodePartFileName(partName, partNumber, _
                                    partRevision, partFileType, partFileName)

  ReDim Preserve pn(0)
  pn(0) = partNumber
  ReDim Preserve rn(0)
  rn(0) = partRevision
  ReDim Preserve pdm(0)
  pdm(0) = "@DB/" & pn(0) & "/" & rn(0)

  sw.WriteLine("pdm(0)  =  " & pdm(0))

  counter = 0
  objs = Nothing

  n_objs = SelectComponents(objs)
  ' this loop converts the NXObjects into Assemblies.Component objects
  ' and puts each one into the selectedComps array
  If (n_objs) < 1 Then
    dTitle = "Clone Selected Components"
    dMessage = "Nothing Selected"
    theUI.NXMessageBox.Show(dTitle, NXMessageBox.DialogType.Warning, dMessage)
    Exit Sub
  End If

  For Each thisObj As NXObject In objs
    aComp = NXObjectManager.Get(thisObj.Tag)
    counter += 1

    ReDim Preserve componentx(counter)
    componentx(counter) = aComp

    ufs.Part.AskPartName(aComp.Prototype.OwningPart.Tag, partName)
    ufs.Ugmgr.DecodePartFileName(partName, partNumber, _
                                    partRevision, partFileType, partFileName)
    ReDim Preserve pn(counter)
    pn(counter) = partNumber
    ReDim Preserve rn(counter)
    rn(counter) = partRevision
    ReDim Preserve pdm(counter)
    pdm(counter) = "@DB/" & pn(counter) & "/" & rn(counter)
  Next

'************************************
'************************************
'************************************
'************************************

  Dim workPart As Part
  workPart = s.Parts.Work

  Dim layout1 As Layout = CType(workPart.Layouts.FindObject("L1"), Layout)
  Dim modelingView1 As ModelingView = CType(workPart.ModelingViews.FindObject("Trimetric"), ModelingView)
  layout1.ReplaceView(workPart.ModelingViews.WorkView, modelingView1, True)

  Dim partLoadStatus1 As PartLoadStatus
  Dim component1 As Assemblies.Component
  Dim partFromPartBuilder1 As PDM.PartFromPartBuilder
  partFromPartBuilder1 = s.Parts.PDMPartManager.NEWPartFromPartBuilder

  For n2 = 1 To pn.Length - 1

    component1 = componentx(n2)

    s.Parts.SetWorkComponent(component1, partLoadStatus1)

    part_num = prefix & pn(n2)
    part_rev = rn(n2)

    Try

      partFromPartBuilder1.CreatePartSpec("External", part_num, part_rev, "master", "")
      partFromPartBuilder1.CreateNonmasterList()
      partFromPartBuilder1.NonmasterSaveAsOption = NXopen.PDM.PartFromPartBuilder.FileSaveAs.All
      partFromPartBuilder1.Commit()

    Catch e As Exception

      sw.WriteLine("-------------------------------------------------------")
      sw.WriteLine("")
      sw.WriteLine("NX Exception  =  " & e.ToString)
      sw.WriteLine("")
      sw.WriteLine("-------------------------------------------------------")

    End Try

  Next
  partLoadStatus1.Dispose()
  partFromPartBuilder1.Dispose()

  Dim nullAssemblies_Component As Assemblies.Component = Nothing

  Dim partLoadStatus2 As PartLoadStatus
  s.Parts.SetWorkComponent(nullAssemblies_Component, partLoadStatus2)

  Dim partFromPartBuilder2 As PDM.PartFromPartBuilder
  partFromPartBuilder2 = s.Parts.PDMPartManager.NEWPartFromPartBuilder

  part_num = prefix & pn(0)
  part_rev = rn(0)

  partFromPartBuilder2.CreatePartSpec("External", part_num, part_rev, "master", "")
  partFromPartBuilder2.CreateNonmasterList()
  partFromPartBuilder2.NonmasterSaveAsOption = NXopen.PDM.PartFromPartBuilder.FileSaveAs.All
  partFromPartBuilder2.Commit()
  partFromPartBuilder2.Dispose()

  Dim partSaveStatus1 As PartSaveStatus
  workPart = s.Parts.Work

  partSaveStatus1 = workPart.Save(BasePart.saveComponents.True, BasePart.CloseAfterSave.False)
  partSaveStatus1.Dispose()

'************************************
'************************************
'************************************
'************************************

'********************************************************
   Dim di As DirectoryInfo
   windir = "D:\display_part_dir\"
   Try
    ' Determine whether the directory exists.
    If Directory.Exists(windir) Then
      sw.WriteLine(windir & "  path exists already.")
     Else

      ' Try to create the directory.
       di = Directory.CreateDirectory(windir)
       sw.WriteLine(windir & " Directory was created successfully at {0}." _
                                             & Directory.GetCreationTime(windir))
     End If

     ' Delete the directory.
     'di.Delete()
     'sw.WriteLine("The directory was deleted successfully.")

   Catch e As Exception
     sw.WriteLine("The process failed: {0}." & e.ToString())
   End Try
'********************************************************

  dTitle = "pany  :  dev name"
  dMessage = "See Clone in folder  ==>  " & windir
  theUI.NXMessageBox.Show(dTitle, NXMessageBox.DialogType.Warning, dMessage)

  'System.IO.Directory.Delete(windir, True)

  ufs.Ui.OpenListingWindow()
  lw.WriteLine(sw.ToString)
  ufs.Ui.SaveListingWindow(windir & "clone_report.txt")

 End Sub

'=========================================================================================
  'it is necessary to select NXObjects, and not Assemblies.Component objects.
  '
  Public Function SelectComponents(ByRef comps() As NXObject) As Integer

     theUI.LockAccess()
     Dim mask(0) As Selection.MaskTriple
     mask(0) = New Selection.MaskTriple(UFConstants.UF_component_type, 0, 0)
     Dim sel1 As Selection.Response
     'Do
        sel1 = theUI.SelectionManager.SelectObjects( _
            "Select components to clone.", _
            "Select components to clone", Selection.SelectionScope.AnyInAssembly, _
            Selection.SelectionAction.ClearAndEnableSpecific, _
            False, False, mask, comps)
     'Loop While sel1 = Selection.Response.ObjectSelected Or _
                'sel1 = Selection.Response.ObjectSelectedByName
     theUI.UnlockAccess()
     Return comps.GetLength(0)

  End Function

  Public Function GetUnloadOption(ByVal dummy As String) As Integer
     Return Session.LibraryUnloadOption.Immediately
  End Function
'=========================================================================================

End Module

 

[Ehaviv]

For NATIVE I found this (also wrote a long ago)

Option Strict Off
Imports System
Imports System.IO
Imports NXOpen
Imports NXOpen.UF
Imports NXOpen.Utilities
Imports NXOpenUI.NXInputBox

Module assy_nameruletype_rename_native_cloning

 Dim theUI As UI = UI.GetUI()

 Sub Main (ByVal args() As String)

  Dim s As Session = Session.GetSession()
  Dim ufs As UFSession = UFSession.GetUFSession
  Dim theUI As UI = UI.GetUI()
  Dim lw As ListingWindow = s.ListingWindow
  Dim display_part As Part = s.Parts.Display
  Dim work_part As Part = s.Parts.Work
 
  Dim windir As String
  Dim sw As New StringWriter()
  Dim prefix As String = "a1_"
  Dim pn(-1) As String
  Dim counter As Integer = -1
  Dim objs() As NXObject = Nothing
  Dim n_objs As Integer = 0
  Dim aComp As Assemblies.Component = Nothing
  Dim partName As String = ""
  Dim dTitle As String
  Dim dMessage As String
  Dim prt_name As String
  Dim prt_cnt As Integer = 1
  Dim n1 As Integer
  Dim display_part_dir As String
  Dim log_file_name As String
  Dim new_dir As String = "a\"
  Dim user_input_str(2) As String

  lw.Open()
  ufs.Ui.ExitListingWindow()

  Do
    user_input_str(0) = GetInputString("Assembly  move \ cloning  :  Enter  new_dir \ prefix", _
                                             "pany  :  dev name", "dir1\p1_")

    If user_input_str(0).Equals("") Then
      Exit Sub
    End If
    user_input_str = user_input_str(0).Split("\")
    If user_input_str.Length < 2 Then Continue Do
    new_dir = user_input_str(0) & "\"
    prefix = user_input_str(1)
  Loop While (user_input_str.Length < 2)

  If work_part.Equals(display_part) Then
    'ok
  Else
    MsgBox("Display Part and Work Part must be the same")
    Exit Sub
  End If

  ufs.Part.AskPartName(display_part.Tag, partName)
  ReDim Preserve pn(0)
  pn(0) = partName            
  display_part_dir = IO.Path.GetDirectoryName(partName)
  display_part_dir = display_part_dir & "\"
  lw.WriteLine("display_part_dir  =  " & display_part_dir)

  counter = 0
  objs = Nothing

  n_objs = SelectComponents(objs)
  ' this loop converts the NXObjects into Assemblies.Component objects
  ' and puts each one into the selectedComps array
  If (n_objs) < 1 Then
    dTitle = "Clone Selected Components"
    dMessage = "Nothing Selected"
    theUI.NXMessageBox.Show(dTitle, NXMessageBox.DialogType.Warning, dMessage)
    Exit Sub
  End If

  For Each thisObj As NXObject In objs
    aComp = NXObjectManager.Get(thisObj.Tag)
    counter += 1
    ufs.Part.AskPartName(aComp.Prototype.OwningPart.Tag, partName)
    ReDim Preserve pn(counter)
    pn(counter) = partName
  Next

  ufs.Clone.Terminate()
  ufs.Clone.Initialise(UFClone.OperationClass.CloneOperation)
  Dim status As UFPart.LoadStatus

  ufs.Clone.AddAssembly(pn(0), status)
   
  ufs.Clone.SetDefAction(UFClone.Action.Retain)
  ufs.Clone.SetDefItemType("External")
  ufs.Clone.SetDefNaming(UFClone.NamingTechnique.NamingRule)

'=========================================================================================
  ufs.Clone.StartIteration()
  Do
    ufs.Clone.Iterate(prt_name)
    lw.WriteLine("Iterate prt_name  ==>>  " & prt_cnt.ToString() & "  ====  " & prt_name)
    If(prt_name = Nothing) Then Continue Do

    For n1 = 0 To pn.Length - 1
      
      If prt_name.Equals(pn(n1)) Then

        'ufs.Clone.AskItemType(input_part_name  As String, item_type As String)        
        'ufs.Clone.SetItemType(input_part_name  As String, item_type As String)
        
        lw.WriteLine("(IO.Path.GetFileName(prt_name))  =====  " & (IO.Path.GetFileName(prt_name)))
        lw.WriteLine("prt_name  =====  " & prt_name)
      Try
        ufs.Clone.SetAction(prt_name, UFClone.Action.Clone, "")
      Catch e As Exception
        'theUI.NXMessageBox.Show("  pany  :  dev name", _
                                  'NXMessageBox.DialogType.Information, msgstr)
        lw.WriteLine("-------------------------------------------------------")
        lw.WriteLine("")
        lw.WriteLine("NX Exception  =  " & e.ToString)
        lw.WriteLine("")
        lw.WriteLine("-------------------------------------------------------")
        Exit Sub
      End Try
        Exit For
      End If

    Next

    prt_cnt = prt_cnt + 1
  Loop While (prt_name <> Nothing)
'=========================================================================================
'********************************************************
   Dim di As DirectoryInfo
   windir = display_part_dir & new_dir
   Try
    ' Determine whether the directory exists.
    If Directory.Exists(windir) Then
      lw.WriteLine(windir & "  path exists already.")
     Else

      ' Try to create the directory.
       di = Directory.CreateDirectory(windir)
       lw.WriteLine(windir & " Directory was created successfully at {0}." _
                                             & Directory.GetCreationTime(windir))
     End If

     ' Delete the directory.
     'di.Delete()
     'lw.WriteLine("The directory was deleted successfully.")

   Catch e As Exception
     lw.WriteLine("The process failed: {0}." & e.ToString())
   End Try

'********************************************************

  Dim namerule1 As UFClone.NameRuleDef
  'PrependString,  AppendString,  ReplaceString
  Dim type1 As UFClone.NameRuleType = UFClone.NameRuleType.PrependString
  namerule1.type = type1
  namerule1.new_string = prefix
  namerule1.base_string = "not_used"

  Dim fail1 As UFClone.NamingFailures
  ufs.Clone.SetNameRule(namerule1, fail1)     
  ufs.Clone.SetDefDirectory(windir)
  ufs.Clone.SetLogfile(log_file_name)   
  ufs.Clone.GenerateReport()
  Dim faile As UFClone.NamingFailures
  ufs.Clone.PerformClone(faile)    
  ufs.Clone.Terminate()

  dTitle = "pany  :  dev name"
  dMessage = "See Clone in folder  ==>  " & windir
  theUI.NXMessageBox.Show(dTitle, NXMessageBox.DialogType.Warning, dMessage)

  'System.IO.Directory.Delete(windir, True)

  ufs.Ui.OpenListingWindow()
  'lw.WriteLine(sw.ToString)
  ufs.Ui.SaveListingWindow(windir & "clone_report.txt")

 End Sub

'=========================================================================================
  'it is necessary to select NXObjects, and not Assemblies.Component objects.
  '
  Public Function SelectComponents(ByRef comps() As NXObject) As Integer

     theUI.LockAccess()
     Dim mask(0) As Selection.MaskTriple
     mask(0) = New Selection.MaskTriple(UFConstants.UF_component_type, 0, 0)
     Dim sel1 As Selection.Response
     'Do
        sel1 = theUI.SelectionManager.SelectObjects( _
            "Select components to clone.", _
            "Select components to clone", Selection.SelectionScope.AnyInAssembly, _
            Selection.SelectionAction.ClearAndEnableSpecific, _
            False, False, mask, comps)
     'Loop While sel1 = Selection.Response.ObjectSelected Or _
                'sel1 = Selection.Response.ObjectSelectedByName
     theUI.UnlockAccess()
     Return comps.GetLength(0)

  End Function

  Public Function GetUnloadOption(ByVal dummy As String) As Integer
     Return Session.LibraryUnloadOption.Immediately
  End Function
'=========================================================================================

End Module

 

[PSI-CAD]

Hi,
Thanks a lot, but I have the following message in NX11.0.1

Regards
Didier Psaltopoulos

http://www.psi-cad.fr

 

[Ehaviv]

Just now I tried it in my nx8.5(the native version)
And it worked.

I need to know what this error mean.

 

[Ehaviv]

https://community.plm.automation.si...Customization/Fatal-error-e434352/td-p/383128

This seen to be not related to the journal as the above link say.

 

[PSI-CAD]

Hi,

Thanks a lot.

I modified the journal for a more simple directory selection and I tried it in NX10

But the result is in UGII_BASE_DIR and not in my selected folder

Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.Assemblies
Imports NXOpen.Features
Imports System.Windows.Forms
Imports NXOpen.UF
Imports NXOpen.Utilities
Imports System.Collections.Generic

Module Main
Dim s As Session = Session.GetSession()
Dim ufs As UFSession = UFSession.GetUFSession()
Dim lw As ListingWindow = s.ListingWindow
Dim NXMessageBox As NXMessageBox = NXOpen.UI.GetUI().NXMessageBox
Dim Folder As String = Nothing
Dim workPart As Part = s.Parts.Work
Dim PartList As List(Of Part) = New List(Of Part)


Sub Main()

Dim basePart As BasePart = s.Parts.BaseWork

If basePart Is Nothing Then
NXMessageBox.Show("", NXMessageBox.DialogType.Error, "No Work Part")
Return
End If

Do_The_Job()

End Sub
Sub Do_The_Job()

Dim dp As Part = s.Parts.Display

Dim SAVE_AS_Attribut As String = ""

Dim DXF_Attribut As String = ""

Dim c As ComponentAssembly = s.Parts.Display.ComponentAssembly
Scan(c.RootComponent, 0)

' Ajout la tête d'assemblage ou la part unitaire dans la liste à traiter (version 1.1)
If Not PartList.Contains(dp) Then PartList.Add(dp)

ufs.Ui.SetStatus("Nombre de parts trouvées= " & PartList.Count)

' ----------------------------------------------
'demande chemin sauvegarde
' ----------------------------------------------
lw.Open()

Dim FolderBrowserDialog As FolderBrowserDialog = New FolderBrowserDialog()

FolderBrowserDialog.SelectedPath = "C:"
FolderBrowserDialog.Description = "Selectionner le dossier ou doivent être sauvegardé les pièce"

If (FolderBrowserDialog.ShowDialog() <> DialogResult.OK) Then Return ' Sort si le user n'a rien indiqué
Folder = FolderBrowserDialog.SelectedPath

'lw.WriteLine("Le directory choisi est :" & Folder)


' ----------------------------------------------
'demande numero projet
' ----------------------------------------------
Dim numeroProjet As String = ""

numeroProjet = InputBox("Enter project number", "numero projet", "")

Dim loadStatus As PartLoadStatus = Nothing





For Each part As Part In PartList
'Echo(vbCrLf & "Traitement de : " & part.FullPath)
'Echo("")
s.Parts.SetDisplay(part, False, True, loadStatus)


' ----------------------------------------------
' Save As...
' ----------------------------------------------
Dim partSaveStatus1 As PartSaveStatus
Try

SAVE_AS_Attribut = s.Parts.Work.GetStringUserAttribute("SAVE_AS", -1)
'lw.WriteLine("L'attribut Save As de la part" & s.Parts.Work.Leaf +" est : " & SAVE_AS_Attribut)
'lw.WriteLine("" )

IF SAVE_AS_Attribut = "YES" THEN

part.SetUserAttribute("DXF", -1, "", Update.Option.Now)

partSaveStatus1 = s.Parts.Work.SaveAs(Folder+"\"+s.Parts.Work.Leaf+"_"+numeroProjet+".prt")
partSaveStatus1.Dispose()
END IF

Catch ex as Exception




End Try

Next

' remet la tete d'assemblage en display part
s.Parts.SetDisplay(dp, False, True, loadStatus)

End Sub

Public Sub Scan(ByVal component As Component, ByVal niveau As Integer)
' ce sous-programme scanne récursivement l'assemblage
' il ne met pas dans la liste , les parts supprimées et non ouvertes
Try
Dim part As Part = CType(component.Prototype, Part)
Dim enfants As Component() = component.GetChildren()

If Not PartList.Contains(part) Then
PartList.Add(part)
For Each comp As Component In enfants
Scan(comp, niveau + 1)
Next
End If
Catch ex As Exception

End Try
End Sub

Public Sub Echo(ByVal output As String)
lw.Open()
lw.WriteLine(output)
End Sub
Public Function GetUnloadOption(ByVal dummy As String) As Integer
GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately
End Function
End Module

Thanks in advance




Regards
Didier Psaltopoulos

http://www.psi-cad.fr