Stepping throug all parts of an assembly. Making each the displayed part and dumping screen shots

So my script is working it seems however I need to find a way to execute the "reset orientation" command.

This makes the view zoom to the saved state it was in. I attempted to record it with a journal but it dose not seem to record any thing.

I updated and based my new script on the bom to excel with thumbnails.

It seems to not go threw all parts in the assembly. Any help would be appreciated.

'################################################################################################################
' Journal to recursively walk through the assembly structure.
' Outputs the full BoM to Excel.
' Generates a screenshot image of each part and adds it to the BoM.
' NX 7.5, with Teamcenter
' Written by Ian Eldred
' Structure taken from an article on from NXJournaling.com February 24, 2012
'################################################################################################################
' Version History:
' Version | Date | Changed by | Description of change
' --------|------------|---------------|-------------------------------------------------------------------------
' 1.0 | 24/06/2014 | Ian Eldred | Initial release
' 1.1 | 24/06/2014 | Ian Eldred | Added check to ensure file exists before adding picture to spreadsheet
' 1.2 | 24/06/2014 | Ian Eldred | Fixed bug with strPicFilesPath variable and re-used it everywhere
' 1.3 | 25/06/2014 | Ian Eldred | Improved the screenshot image cropping
' 1.4 | 26/06/2014 | Ian Eldred | Changed messages displayed to user if an existing excel file is selected
' 1.5 | 27/06/2014 | Ian Eldred | Made columns easier to change. Removed surplus columns at the end.
'################################################################################################################

Option Strict Off

Imports System
Imports System.IO
Imports System.Windows.Forms
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices
Imports NXOpen
Imports NXOpen.UF
Imports NXOpen.Assemblies
Imports NXOpenUI

Module BomToExcel

Public theSession As Session = Session.GetSession()
Public ufs As UFSession = UFSession.GetUFSession()
Public theUISession As UI = UI.GetUI
Public lw As ListingWindow = theSession.ListingWindow
Const xlCenter As Long = -4108
Const xlDown As Long = -4121
Const xlUp As Long = -4162
Const xlFormulas As Long = -4123
Const xlLeft As Long = -4131
Const xlAbove As Long = 0
Const xlWhole As Long = 1
Const xlByRows As Long = 1
Const xlNext As Long = 1
Const msoTrue As Long = -1
Const strPicFilesPath As String = "c:\partimages\"
Dim lngLevelStart(20) As Long
Dim colLevel As Integer = 1
Dim colImage As Integer = 2
Dim colID As Integer = 3
Dim colDescription As Integer = 4
Dim colQuantity As Integer = 5
Dim colParentChild As Integer = 6
Dim colParent As Integer = 7
Dim colBranchTop As Integer = 8
Dim colBranchCreated As Integer = 9
Private IsTcEng As Boolean = False
Dim lg As LogFile = theSession.LogFile

dim moleDisplayedPartName as string

public outputDirectoryForMolesMagic as string

Sub Main()
outputDirectoryForMolesMagic = "c:\temp\nx export"
outputDirectoryForMolesMagic = outputDirectoryForMolesMagic +"\"+ InputBox("Enter a folder name for export", "Mole Tastic", "")
'shell("rmdir /Q /S "+chr(34)+outputDirectoryForMolesMagic+chr(34))
MkDir( outputDirectoryForMolesMagic)
Dim dispPart As Part = theSession.Parts.Display
Dim workPart As Part = theSession.Parts.Work
Dim objExcel As Object
Dim objWorkbook As Object
Dim objWorksheet As Object

lg.WriteLine("~~~~ Start of BomToExcel journal ~~~~")
lg.WriteLine("Timestamp: " & Now)
lg.WriteLine("")

'determine if we are running under TC or native
ufs.UF.IsUgmanagerActive(IsTcEng)
lg.WriteLine("TC running? " & IsTcEng)

Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "journal")

Dim excelFileName As String
Dim excelFileExists As Boolean = False
Dim row As Long = 1
Dim column As Long = 1

excelFileName = "C:\TEMP\CRAPFILE.XLS"

'This function will not complain if the directory already exists.
System.IO.Directory.CreateDirectory(strPicFilesPath)

'lw.Open()

'create Excel object
objExcel = CreateObject("Excel.Application")
If objExcel Is Nothing Then
'theUISession.NXMessageBox.Show("Error", NXMessageBox.DialogType.Error, "Could not start Excel, journal exiting")
lg.WriteLine("Could not start Excel, journal exiting")
theSession.UndoToMark(markId1, "journal")
Exit Sub
Else
lg.WriteLine("Excel started successfully")
End If

If File.Exists(excelFileName) Then
'Open the Excel file
excelFileExists = True
objWorkbook = objExcel.Workbooks.Open(excelFileName)
lg.WriteLine("Excel file: '" & excelFileName & "' exists, opening file")
Else
'Create the Excel file
objWorkbook = objExcel.Workbooks.Add
objWorkbook.SaveAs(excelFileName)
lg.WriteLine("Excel file: '" & excelFileName & "' does not exist, creating file")
End If
If objWorkbook Is Nothing Then
lg.WriteLine("Could not open/create specified Excel file: '" & excelFileName & "'")
lg.WriteLine("journal exiting")
theUISession.NXMessageBox.Show("Error", NXMessageBox.DialogType.Error, "Could not open Excel file: " & excelFileName & ControlChars.NewLine & "journal exiting.")
theSession.UndoToMark(markId1, "journal")
Exit Sub
Else
lg.WriteLine("objWorkbook created/opened successfully")
End If

'Add a new sheet so that previously exported BoMs are not affected
objWorksheet = objWorkbook.Worksheets.Add()

'Add Column Titles
objWorksheet.Cells(1, colLevel).Value = "Level"
objWorksheet.Cells(1, colImage).EntireColumn.ColumnWidth = 10
objWorksheet.Cells(1, colImage).Value = "Images"
objWorksheet.Cells(1, colID).Value = "ID"
objWorksheet.Cells(1, colDescription).Value = "Description"
objWorksheet.Cells(1, colQuantity).Value = "Quantity"
objWorksheet.Cells(1, colParentChild).Value = "Parent|Child"
objWorksheet.Cells(1, colParent).Value = "Parent"
objWorksheet.Cells.VerticalAlignment = xlCenter
lg.WriteLine("Column titles added")
Try
Dim c As ComponentAssembly = dispPart.ComponentAssembly
If Not IsNothing(c.RootComponent) Then
'Process 'root component' (assembly file)
Dim rootDispName As String = (c.RootComponent.DisplayName).Replace("/", "_")

'msgbox(rootDispName)

lg.WriteLine("processing assembly file")
lg.WriteLine(" display name: " & c.RootComponent.DisplayName)
objWorksheet.Cells(2, colLevel).Value = 0
objWorksheet.Cells(2, colID).Value = rootDispName

If IsTcEng Then
objWorksheet.Cells(2, colDescription).Value = c.RootComponent.GetStringAttribute("DB_PART_NAME")
lg.WriteLine(" DB_PART_NAME: " & c.RootComponent.GetStringAttribute("DB_PART_NAME"))
Else
objWorksheet.cells(2, colDescription).Value = c.RootComponent.Prototype.OwningPart.Leaf
lg.WriteLine(" Part name: " & c.RootComponent.Prototype.OwningPart.Leaf)
End If

lngLevelStart(0) = 3
'Create a screenshot only if one does not already exist

'moleDisplayedPartName = rootDispName

CreateCroppedNxScreenshot()

reportComponentChildren(c.RootComponent, 1, objWorksheet)
Dim partLoadStatus1 As PartLoadStatus
Dim status1 As PartCollection.SdpsStatus
status1 = theSession.Parts.SetDisplay(dispPart, False, False, partLoadStatus1)
partLoadStatus1.Dispose()
Else
'Process a piece part
End If
Catch e As Exception
theSession.ListingWindow.WriteLine("Failed: " & e.ToString)
End Try

objWorksheet.Cells.EntireColumn.AutoFit()

'Some variables required within excel
Dim rngStart As Object
Dim rngEnd As Object
Dim intIndent As Single
Dim intLeft As Single
Dim intTopRow As Integer
Dim i As Integer
Dim j As Integer
Dim lngStart As Long
Dim lngLevel As Long
Dim lngLastRow As Long
intIndent = 6.75
lngLastRow = objWorksheet.Cells(2, colLevel).End(xlDown).Row

'####### Add pictures to excel structure ################
Dim strFileName As String
For i = 2 To lngLastRow
strFileName = strPicFilesPath & objWorksheet.Cells(i, colID).Value & ".jpg"
If File.Exists(strFileName) Then
With objWorksheet.Pictures.Insert(strFileName)
With .ShapeRange
.LockAspectRatio = msoTrue
If .Width >= .Height Then
.Width = objWorksheet.Cells(i, colImage).Width - 6
Else
.Height = objWorksheet.Cells(i, colImage).Width - 6
End If
objWorksheet.Cells(i, colImage).EntireRow.RowHeight = .Height + 6
End With
.Left = objWorksheet.Cells(i, colImage).Left + 3 + intIndent * objWorksheet.Cells(i, colID).IndentLevel
.Top = objWorksheet.Cells(i, colImage).Top + 3
.Placement = 1 'Move and Size
.PrintObject = True
End With
End If
Next i
'####### End Add pictures to excel structure ################

'####### Add groupings to excel structure ################
With objWorksheet.Outline
.AutomaticStyles = False
.SummaryRow = xlAbove
.SummaryColumn = xlLeft
End With
For j = 8 To 1 Step -1
lngStart = 0
'Loop through rows
For i = 2 To lngLastRow
lngLevel = Int(objWorksheet.Cells(i, colLevel).Value)
If lngLevel = j And lngStart = 0 Then
lngStart = i
ElseIf lngLevel < j And lngStart > 0 Then
objWorksheet.Rows(lngStart & ":" & i - 1).EntireRow.Group()
lngStart = 0
ElseIf i = lngLastRow And lngStart > 0 Then
objWorksheet.Rows(lngStart & ":" & i).EntireRow.Group()
lngStart = 0
End If
Next i
Next j
'####### End Add groupings to excel structure ################

'####### Add branches to excel structure ################
For i = objWorksheet.Cells(3, colBranchTop).End(xlDown).Row To 3 Step -1
intTopRow = objWorksheet.Cells(i, colBranchTop).Value
rngEnd = objWorksheet.Cells(i, colID)
intLeft = rngEnd.offset(0, -1).Left + intIndent * (rngEnd.IndentLevel - 0.5)
If objWorksheet.Cells(intTopRow, colBranchCreated).Value <> 1 Then
'This is the first line with that parent, so need to draw a vertical line
rngStart = objWorksheet.Cells(intTopRow, colID)
With objWorksheet.Shapes.AddLine(intLeft, CSng(rngStart.Top), intLeft, CSng(rngEnd.Top + rngEnd.Height / 2))
.Line.Weight = 1.5
.Line.ForeColor.RGB = 0
End With
objWorksheet.Cells(intTopRow, colBranchCreated).Value = 1
End If
'Draw a horizontal line
With objWorksheet.Shapes.AddLine(intLeft, CSng(rngEnd.Top + rngEnd.Height / 2), intLeft + intIndent / 2, CSng(rngEnd.Top + rngEnd.Height / 2))
.Line.Weight = 1.5
.Line.ForeColor.RGB = 0
End With
Next i
objWorksheet.Cells(1, colLevel).EntireColumn.Delete()
objWorksheet.Cells(1, colParentChild).EntireColumn.Delete()
objWorksheet.Cells(1, colParent).EntireColumn.Delete()
objWorksheet.Cells(1, colBranchTop).EntireColumn.Delete()
objWorksheet.Cells(1, colBranchCreated).EntireColumn.Delete()
'####### End Add branches to excel structure ############

'lw.Close()

If excelFileExists Then
'theUISession.NXMessageBox.Show("BoM to Excel Complete", NXMessageBox.DialogType.Information, "A new sheet has been added to the Excel file: " & excelFileName & ".")
Else
'theUISession.NXMessageBox.Show("BoM to Excel Complete", NXMessageBox.DialogType.Information, "The Excel file: " & excelFileName & " has been created.")
End If

objWorkbook.Save()
objWorkbook.Close()
objExcel.Quit()
objWorksheet = Nothing
objWorkbook = Nothing
objExcel = Nothing

lg.WriteLine(" ~~~ End of BomToExcel journal ~~~ ")
lg.WriteLine(" timestamp: " & Now)
lg.WriteLine("")
Shell( "explorer.exe "+outputDirectoryForMolesMagic, vbMaximizedFocus )
End Sub

'**********************************************************
Sub reportComponentChildren(ByVal comp As Component, _
ByVal indent As Integer, ByRef xlsWorkSheet As Object)

lg.WriteLine("")
lg.WriteLine(" reportComponentChildren(" & comp.DisplayName & ", " & "indent: " & indent & ")")
lg.WriteLine(" component path: " & comp.Prototype.OwningPart.FullPath)

Dim compDispName As String = (comp.DisplayName).Replace("/", "_")

'msgbox("Report Componet Children"+compDispName)
moleDisplayedPartName = compDispName

Dim childDispName As String

Dim lngFoundInRow As Long = -1
Dim strFindString As String
Dim intWriteRow As Integer
Dim doSearch As Boolean = False
If lngLevelStart(indent) = 0 Then lngLevelStart(indent) = xlsWorkSheet.Cells(1, 1).end(xlDown).offset(1, 0).Row
lg.WriteLine(" lngLevelStart(" & indent.ToString & ") = " & lngLevelStart(indent).ToString)

For Each child As Component In comp.GetChildren()

childDispName = (child.DisplayName).Replace("/", "_")

moleDisplayedPartName = childDispName

'lg.WriteLine(" processing child component: " & child.Prototype.OwningPart.Leaf)
'Search for Parent|Child to see if it already exists.
strFindString = compDispName & "|" & childDispName
lg.WriteLine(" strFindString = " & strFindString)
'On Error Resume Next

'msgbox(strFindString)

Dim searchRange As Object = Nothing
Dim foundRange As Object

Try
lg.WriteLine(" xlsWorkSheet.Cells(" & indent.ToString & ", " & colParentChild.ToString & ").Value = " & """" & xlsWorkSheet.Cells(lngLevelStart(indent), colParentChild).Value & """")
If xlsWorkSheet.Cells(lngLevelStart(indent), colParentChild).Value = "" Then
'no data entered to search yet
lg.WriteLine(" no data available for search")
Else
If xlsWorkSheet.Cells(lngLevelStart(indent), colParentChild).Offset(1).Value = "" Then
'only 1 value entered
searchRange = xlsWorkSheet.Cells(lngLevelStart(indent), colParentChild)
doSearch = True
lg.WriteLine(" number of rows available for search: " & searchRange.Rows.Count.ToString)
Else
'2 or more values entered, select them all
searchRange = xlsWorkSheet.Range(xlsWorkSheet.Cells(lngLevelStart(indent), colParentChild), xlsWorkSheet.Cells(lngLevelStart(indent), colParentChild).End(xlDown))
doSearch = True
lg.WriteLine(" number of rows available for search: " & searchRange.Rows.Count.ToString)
End If

End If

If doSearch Then
foundRange = searchRange.Find(strFindString, , xlFormulas, xlWhole, xlByRows, xlNext, False, , )
End If

If IsNothing(foundRange) Then
lg.WriteLine(" foundRange is Nothing")
Else
lngFoundInRow = foundRange.Row
lg.WriteLine(" lngFoundInRow = " & lngFoundInRow.ToString)
End If

Catch ex As Exception
lg.WriteLine(" ** excel search error")
lg.WriteLine(" ** " & ex.Message)
End Try

'If Not lngFoundInRow = 0 Then
If lngFoundInRow > -1 Then

lg.WriteLine(" found in row: " & lngFoundInRow.ToString & ", adding to quantity")
xlsWorkSheet.Cells(lngFoundInRow, colQuantity).Value = xlsWorkSheet.Cells(lngFoundInRow, colQuantity).Value + 1
Else
lg.WriteLine(" not found, creating new record")
'Add new component or subassembly
intWriteRow = xlsWorkSheet.Cells(1, 1).end(xlDown).offset(1, 0).Row
xlsWorkSheet.Cells(intWriteRow, colLevel).Value = indent
xlsWorkSheet.Cells(intWriteRow, colID).Value = childDispName
xlsWorkSheet.Cells(intWriteRow, colID).IndentLevel = indent

If IsTcEng Then
xlsWorkSheet.Cells(intWriteRow, colDescription).Value = child.GetStringAttribute("DB_PART_NAME")
Else
xlsWorkSheet.cells(intWriteRow, colDescription).Value = child.Prototype.OwningPart.Leaf
End If

xlsWorkSheet.Cells(intWriteRow, colQuantity).Value = child.GetIntegerQuantity
xlsWorkSheet.Cells(intWriteRow, colParentChild).Value = strFindString
xlsWorkSheet.Cells(intWriteRow, colParent).Value = compDispName
xlsWorkSheet.Cells(intWriteRow, colBranchTop).Value = lngLevelStart(indent)
'Create a screenshot only if one does not already exist

lg.WriteLine(" screenshot does not exist, creating: " & strPicFilesPath & childDispName & ".jpg")

Dim Part1 As Part
If IsTcEng Then
Part1 = CType(theSession.Parts.FindObject("@DB/" & child.GetStringAttribute("DB_PART_NO") & "/" & child.GetStringAttribute("DB_PART_REV")), Part)
lg.WriteLine(" Part1: " & "@DB/" & child.GetStringAttribute("DB_PART_NO") & "/" & child.GetStringAttribute("DB_PART_REV"))
Else
Part1 = child.Prototype.OwningPart
lg.WriteLine(" Part1: " & Part1.FullPath)
End If

Dim partLoadStatus1 As PartLoadStatus
Dim status1 As PartCollection.SdpsStatus
status1 = theSession.Parts.SetDisplay(Part1, True, True, partLoadStatus1)
CreateCroppedNxScreenshot()
partLoadStatus1.Dispose()

reportComponentChildren(child, indent + 1, xlsWorkSheet)
'On Error GoTo 0
End If
Next
lngLevelStart(indent) = 0

lg.WriteLine(" End of processing component: " & comp.DisplayName)
lg.WriteLine("")

End Sub
'**********************************************************
Public Function GetUnloadOption(ByVal dummy As String) As Integer
Return Session.LibraryUnloadOption.Immediately
End Function
'**********************************************************
Sub CreateCroppedNxScreenshot()
'MSGBOX("i HAVE A JOB TO DO")
dim donotlookat = 0
Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim wpModelingView As ModelingView
For Each wpModelingView In workPart.ModelingViews
'msgbox(wpModelingView.Name)
donotlookat = 0
if UCase(wpModelingView.Name) = "BACK" then donotlookat = 1
if UCase(wpModelingView.Name) = "TOP" then donotlookat = 1
if UCase(wpModelingView.Name) = "FRONT" then donotlookat = 1
if UCase(wpModelingView.Name) = "LEFT" then donotlookat = 1
if UCase(wpModelingView.Name) = "RIGHT" then donotlookat = 1
if UCase(wpModelingView.Name) = "BOTTOM" then donotlookat = 1
if UCase(wpModelingView.Name) = "TRIMETRIC" then donotlookat = 1
if UCase(wpModelingView.Name) = "ISOMETRIC" then donotlookat = 1

if donotlookat = 0 then
'exportCurentView(child.DisplayName()+" "+wpModelingView.Name)
LookAtMyPrettyView(wpModelingView.Name)
'exportCurentView(wpModelingView.Name)
'MessageBox.Show(wpModelingView.Name)
end if
next

end sub

Sub LookAtMyPrettyView(byval viewtoget as string)

Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work

Dim displayPart As Part = theSession.Parts.Display

'Dim markId1 As Session.UndoMarkId
'markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Replace View from Popup")

Dim layout1 As Layout = CType(workPart.Layouts.FindObject("L1"), Layout)

Dim modelingView1 As ModelingView = CType(workPart.ModelingViews.FindObject(viewtoget), ModelingView)
layout1.ReplaceView(workPart.ModelingViews.WorkView, modelingView1, True)

Dim layout2 As Layout = CType(workPart.Layouts.FindObject("L1"), Layout)

Dim modelingView2 As ModelingView = CType(workPart.ModelingViews.FindObject(viewtoget), ModelingView)
layout2.ReplaceView(workPart.ModelingViews.WorkView, modelingView2, True)
'msgbox(viewtoget)
exportCurentView(viewtoget)
End Sub

Sub exportCurentView(byval filenameForExport as string)
dim theSession As Session = Session.GetSession()
dim ufs As UFSession = UFSession.GetUFSession()
'Create a JPG screenshot ###################
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim c As ComponentAssembly = displayPart.ComponentAssembly
'theSession.Preferences.ScreenVisualization.FitPercentage = 100
'turn triad off
'theSession.Preferences.ScreenVisualization.TriadVisibility = 0
'turn WCS off
displayPart.WCS.Visibility = False
'turn off view/model names display and borders
displayPart.Preferences.NamesBorderVisualization.ShowModelViewNames = True
displayPart.Preferences.NamesBorderVisualization.ShowModelViewBorders = False
'Trimetric view

Dim numberHidden As Integer
numberHidden = theSession.DisplayManager.HideByType(DisplayManager.ShowHideType.Datums, DisplayManager.ShowHideScope.AnyInAssembly)
numberHidden = theSession.DisplayManager.HideByType(DisplayManager.ShowHideType.Sketches, DisplayManager.ShowHideScope.AnyInAssembly)
'Set the filename
'Dim prtJpg As String = outputDirectoryForMolesMagic+"\"+displayPart.name+" - "+filenameForExport+".jpg"
Dim prtJpg As String = outputDirectoryForMolesMagic+"\"+moleDisplayedPartName+"-"+filenameForExport+".jpg"

'lw.WriteLine("Created Screen Shot "+displayPart)

'msgbox(prtJpg)
'Create the image
ufs.Disp.CreateImage(prtJpg, UFDisp.ImageFormat.Jpeg, UFDisp.BackgroundColor.White)
'End Create a JPG screenshot ###################
'msgbox("Click ok to see screen shot")
End Sub

End Module