Clone assembly using vb

Hello NXJournaling,

Below is an attempt on making a save-as on all parts of the assembly with user defined names. I did not come across the above example earlier, which would have saved me considerable amount of time for this attempt. I have used the Journal by Ian.eldred which exports the BOM as excel with pictures from the link http://nxjournaling.com/content/export-assembly-excel-pictures-0

I wasn't knowing how to segregate the child and the assembly parts for the part save order. So i have used the above journal which has the grouping in the excel BOM list which was very useful. I used the same BOM to update the new names for the parts to be saved. This journal may not look impressive, but helped me understand dictionary and listing the dictionary objects.
Have copied codes for my journal from several other Journals from this forum.
Could this Journal be updated to work more efficiently. Thanks, B

' NX 12.0.1.7
' Journal created by Balaji_Sampath03 on Fri Aug 14 20:30:10 2020 India Standard Time
'**************************************************************************************
'This Journal saves all parts / assemblies with the user defined name in the selected folder
'1> Run the export assembly with pictures journal by ian.eldred from below link:
http://www.nxjournaling.com/content/export-assembly-excel-pictures
'2> Update the Description column from the ablove journal with the new name for the parts.
'3> Run this journal and Select the updated excel & the folder location for saving the assembly
'This Journal does not have any exception to catch any errors
'***************************************************************************************

Option Strict Off

Imports System
Imports NXOpen
Imports NXOpen.Assemblies
Imports NXOpen.Features
Imports System.Windows.Forms
Imports NXOpen.UF
Imports NXOpenUI
Imports NXOpen.Utilities
Imports System.Linq
Imports System.Collections.Generic
Imports System.Text.RegularExpressions

Module AssemblySaveAs

Dim theSession As Session = Session.GetSession()
Dim theUfSession As UFSession = UFSession.GetUFSession()
Dim theUISession As UI = UI.GetUI
Dim lw As ListingWindow = theSession.ListingWindow

Dim PartList As List(Of Part) = New List(Of Part)
Dim assyPartSaveOrder As List(Of Part) = New List(Of Part)
Dim oldPartNum As New List(Of String)
Dim newPartNum As New List(Of String)
Dim assyNum As New List(Of String)
Dim assyLevel As New List(Of Integer)
Dim uniqueAssyLevel As New List(Of Integer)
Dim Folder As String = Nothing
Dim dictionary As New Collections.Generic.Dictionary(Of Part, Integer)

Sub Main()

Dim markId1 As NXOpen.Session.UndoMarkId = Nothing
markId1 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Visible, "Save All Components")

Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim oldPartName As String = Nothing
Dim newPartName As String = Nothing

If IsNothing(theSession.Parts.Work) Then
'active part required
Return
End If

Dim excelBom As String = ChooseBomFile()
If excelBom = "" Then
' user pressed cancel
Return
End If

StoreChildName(excelBom)

Dim dPart As Part = theSession.Parts.Display
Dim compAssembly As ComponentAssembly = theSession.Parts.Display.ComponentAssembly
Scan(compAssembly.RootComponent, 0)

' Add the assembly head or the unit part in the list to be processed (version 1.1)

If Not PartList.Contains(displayPart) Then PartList.Add(displayPart)
'theUfSession.Ui.SetStatus("Number of Parts found= " & PartList.Count)

'--------------------------------------------------
'Add assembly / Assembly part & level to dictionary
'--------------------------------------------------

For Each part As Part In PartList
Dim testAssyPartName As String = part.Name
If oldPartNum.Contains(testAssyPartName) Then
Dim pos As Integer = oldPartNum.FindIndex(Function (X As String) X.Contains(part.Name))
dictionary.Add(part, assyLevel.Item(pos))
Else
' Do Nothing
End If
Next

'-----------------------------
' Sort Dictionary by key value
'-----------------------------

'Dim assyLevelVal As New List(Of Integer)(dictionary.values)
'assyLevelVal.Sort()

'------------------------------
'Make unique and Sort AssyLevel
'------------------------------

Dim Exist As Boolean = False
For Each assemblyLevel As Integer In assyLevel
Exist = False
For Each uniqAssLevel As Integer In uniqueAssyLevel
If assemblyLevel = uniqAssLevel Then
Exist = True
Exit For
End If
Next
If Not Exist Then
uniqueAssyLevel.Add(assemblyLevel)
End If
Next

assyLevel.Sort(AddressOf CompareAssyLevel)
assyLevel.Reverse
uniqueAssyLevel.Reverse

'---------------------------------------------------------
'Sort assembly in descending order based on assembly level
'---------------------------------------------------------

lw.Open()
'lw.Writeline(" ")
lw.Writeline("Unique Assembly Level Count is: " & uniqueAssyLevel.Count)

assyPartSaveOrder.Clear()

For Each val As Integer in uniqueAssyLevel
If dictionary.ContainsValue(val) Then
For Each pair As KeyValuePair(Of Part, Integer) In dictionary
If pair.Value = val Then
assyPartSaveOrder.Add(pair.key)
End If
Next
End If
Next

'---------------------------------------
'Browse folder location for saving parts
'---------------------------------------

Dim FolderBrowserDialog As FolderBrowserDialog = New FolderBrowserDialog()
If (FolderBrowserDialog.ShowDialog() <> DialogResult.OK) Then Return 'Exit if the user has not indicated anything
Folder = FolderBrowserDialog.SelectedPath

'----------------
'Save child parts
'----------------

For Each part As Part In assyPartSaveOrder
Dim partToSave As String = Part.Name
Dim part1 As NXOpen.Part = CType(theSession.Parts.FindObject(partToSave), NXOpen.Part)
Dim partLoadStatus1 As NXOpen.PartLoadStatus = Nothing
Dim status1 As NXOpen.PartCollection.SdpsStatus = Nothing
status1 = theSession.Parts.SetActiveDisplay(part1, NXOpen.DisplayPartOption.AllowAdditional, NXOpen.PartDisplayPartWorkPartOption.UseLast, partLoadStatus1)

workPart = theSession.Parts.Work ' partToSave
displayPart = theSession.Parts.Display ' partToSave

Dim pos As Integer = oldPartNum.FindIndex(Function (X As String) X.Contains(partToSave))
newPartName = newPartNum.Item(pos)

Try
Dim partSaveStatus1 As NXOpen.PartSaveStatus = Nothing
partSaveStatus1 = workPart.SaveAs(Folder+"\"+newPartName+".prt")
partSaveStatus1.Dispose()

Catch ex As Exception

End Try

partLoadStatus1.Dispose()
workPart.Undisplay()
workPart = Nothing
displayPart = Nothing
Next

lw.Open()
lw.Writeline(" ")
lw.Writeline("Assembly is stored in:" & Folder)
lw.Close()

assyLevel.Clear()

End Sub

Function ChooseBomFile() As String

Dim fdlg As OpenFileDialog = New OpenFileDialog()
fdlg.Title = "Select Excel BOM file"
Dim dir As String
dir = System.Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments)
'dir = "C:\temp"
fdlg.InitialDirectory = dir
fdlg.Filter = "Excel Files(*.xls;*.xlsx;*.xlsm)|*.xls;*.xlsx;*.xlsm"
fdlg.FilterIndex = 2
fdlg.RestoreDirectory = True
If fdlg.ShowDialog() = DialogResult.OK Then
Return fdlg.FileName
Else
Return ""
End If

End Function

Sub StoreChildName(ByVal excelFileName As String)

'-------------------
'create Excel object
'-------------------
Dim objExcel = CreateObject("Excel.Application")

'--------------------
' Try to access Excel
'--------------------

If objExcel Is Nothing Then
theUISession.NXMessageBox.Show("Error", NXMessageBox.DialogType.Error, "Could not start Excel, journal exiting")
Exit Sub
End If

'---------------
'open excel file
'---------------

Dim objWorkbook = objExcel.Workbooks.Open(excelFileName)
objExcel.visible = False

'----------------------------------------------------------------------
' we skip the first row, as we assume this contains the column headings
'----------------------------------------------------------------------
Dim row As Integer
row = 2

Dim oldPartData As String

Do
'---------------
'Read excel cell
'---------------
oldPartData = objExcel.Cells(row, 2).Value

If Not String.IsNullOrWhiteSpace(oldPartData)
oldPartNum.Add(objWorkbook.activesheet.cells(row, 2).value)
newPartNum.Add(objWorkbook.activesheet.cells(row, 3).value)
assyNum.Add(objWorkbook.activesheet.cells(row, 5).value)
assyLevel.Add(objWorkbook.activesheet.cells(row, 6).value)
End If

row = row + 1

Loop Until String.IsNullOrWhiteSpace(oldPartData)

'---------------------------------------------------
'Remove null or empty space from assynum | colum E |
'---------------------------------------------------

assyNum.RemoveAll(Function(str) String.IsNullOrWhiteSpace(str))

'----------------------------------------------------------------------
'Check for old & New Part number count & ask user to add missing values
'----------------------------------------------------------------------

'If newPartNum.Count < oldPartNum.Count Then
'lw.Open()
'lw.writeline("New Part number not available for all parts. Update excel to proceed")
'End If

'---------------------------------------------------------------------------------------------------
'Add Old Part Number, New Part Number, Assembly Part & Assembly Level from columns | B | C | E & F |
'---------------------------------------------------------------------------------------------------

' For i As Integer = 0 To assyNum.Count -1
' assyNum.Item(i) = assyNum.Item(i).Remove(assyNum.Item(i).IndexOf("|") + 1)
' assyNum.Item(i) = Regex.Replace(assyNum.Item(i), "[\|]", String.Empty)
' 'subAssyNum.Add(assyNum.Item(i))
'
' If uniqueAssyNum.Contains(assyNum.Item(i)) Then
' ' Do Nothing
' Else
' '--------------------------------------
' 'remove duplicates from assembly number
' '--------------------------------------
' uniqueAssyNum.Add(assyNum.Item(i))
' End If
' i = i+1
' Next

objExcel.Quit()
objWorkbook = Nothing
objExcel = Nothing

End Sub

Public Sub Scan(ByVal component As Component, ByVal level As Integer)
' this subroutine recursively scans the assembly
' it does not put in the list, the deleted and not opened Parts
Try
Dim part As Part = CType(component.Prototype, Part)
Dim childComp As Component() = component.GetChildren()

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

Private Function CompareAssyLevel(ByVal x As Integer, ByVal y As Integer) As Integer

'case-insensitive sort
Dim myStringComp As StringComparer = StringComparer.CurrentCultureIgnoreCase

'for a case-sensitive sort (A-Z then a-z), change the above option to:
'Dim myStringComp As StringComparer = StringComparer.CurrentCulture

Return myStringComp.Compare(x, y)

End Function

Public Function GetUnloadOption(ByVal dummy As String) As Integer

'Unloads the image when the NX session terminates
GetUnloadOption = NXOpen.Session.LibraryUnloadOption.AtTermination

'----Other unload options-------
'Unloads the image immediately after execution within NX
GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately

'Unloads the image explicitly, via an unload dialog
'GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Explicitly
'-------------------------------

End Function

End Module