Export Assembly to Excel with pictures

Submitted by NXJournaling on Fri, 10/03/2014 - 12:48

Below is a journal taken from the forums that I believe deserves more exposure, it was submitted by user ian.eldred. The journal analyzes the assembly structure and exports a BOM to Excel. A small thumbnail picture of each component is added next to the corresponding entry and the assembly hierarchy is visually represented by Excel groups that you can expand/collapse as desired. The resulting Excel BOM is both useful and visually pleasing. It is a great example of working with Excel in journal code. From ian.eldred:


I wanted to share my first attempt at a Journal file. This Journal is based on the assembly recursion example on this site, but adds in an export to excel with screenshot images. The screenshots are cropped and re-sized to keep the excel file size small. It would be great if others could try it out and let me know if it works on other systems. Please post comments below. Ian


'################################################################################################################
' 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 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

Sub Main()
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

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

'Allow the user to create a new excel file or add to an existing one.
Dim SaveFileDialog1 As New SaveFileDialog
With SaveFileDialog1
.Title = "Save BoM to Excel File"
.InitialDirectory = "Z:\NX Macros"
.Filter = "Excel files (*.xlsx)|*.xlsx|Macro enabled Excel files (*.xlsm)|*.xlsm|All files (*.*)|*.*"
.FilterIndex = 1
.RestoreDirectory = True
.OverwritePrompt = False
.FileName = dispPart.ComponentAssembly.RootComponent.DisplayName
If .ShowDialog() = DialogResult.OK Then
excelFileName = .FileName
Else
Exit Sub
End If
End With

'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")
theSession.UndoToMark(markId1, "journal")
Exit Sub
End If

If File.Exists(excelFileName) Then
'Open the Excel file
excelFileExists = True
objWorkbook = objExcel.Workbooks.Open(excelFileName)
Else
'Create the Excel file
objWorkbook = objExcel.Workbooks.Add
objWorkbook.SaveAs(excelFileName)
End If
If objWorkbook Is Nothing Then
theUISession.NXMessageBox.Show("Error", NXMessageBox.DialogType.Error, "Could not open Excel file: " & excelFileName & ControlChars.NewLine & "journal exiting.")
theSession.UndoToMark(markId1, "journal")
Exit Sub
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
Try
Dim c As ComponentAssembly = dispPart.ComponentAssembly
If Not IsNothing(c.RootComponent) Then
'Process 'root component' (assembly file)
objWorksheet.Cells(2, colLevel).Value = 0
objWorksheet.Cells(2, colID).Value = c.RootComponent.DisplayName
objWorksheet.Cells(2, colDescription).Value = c.RootComponent.GetStringAttribute("DB_PART_NAME")
lngLevelStart(0) = 3
'Create a screenshot only if one does not already exist
If Not File.Exists(strPicFilesPath & c.RootComponent.DisplayName & ".jpg") Then
CreateCroppedNxScreenshot()
End If
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

End Sub

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

Dim lngFoundInRow As Long
Dim strFindString As String
Dim intWriteRow As Integer
If lngLevelStart(indent) = 0 Then lngLevelStart(indent) = xlsWorkSheet.Cells(1, 1).end(xlDown).offset(1, 0).Row
For Each child As Component In comp.GetChildren()
'Search for Parent|Child to see if it already exists.
strFindString = comp.DisplayName & "|" & child.DisplayName
On Error Resume Next
lngFoundInRow = 0
lngFoundInRow = xlsWorkSheet.Range(xlsWorkSheet.Cells(lngLevelStart(indent), colParentChild), xlsWorkSheet.Cells(lngLevelStart(indent), colParentChild).end(xlDown)).Find(What:=strFindString, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Row
If Not lngFoundInRow = 0 Then
xlsWorkSheet.Cells(lngFoundInRow, colQuantity).Value = xlsWorkSheet.Cells(lngFoundInRow, colQuantity).Value + 1
Else
'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 = child.DisplayName
xlsWorkSheet.Cells(intWriteRow, colID).IndentLevel = indent
xlsWorkSheet.Cells(intWriteRow, colDescription).Value = child.GetStringAttribute("DB_PART_NAME")
xlsWorkSheet.Cells(intWriteRow, colQuantity).Value = child.GetIntegerQuantity
xlsWorkSheet.Cells(intWriteRow, colParentChild).Value = strFindString
xlsWorkSheet.Cells(intWriteRow, colParent).Value = comp.DisplayName
xlsWorkSheet.Cells(intWriteRow, colBranchTop).Value = lngLevelStart(indent)
'Create a screenshot only if one does not already exist
If Not File.Exists(strPicFilesPath & child.DisplayName & ".jpg") Then
Dim Part1 As Part = CType(theSession.Parts.FindObject("@DB/" & child.GetStringAttribute("DB_PART_NO") & "/" & child.GetStringAttribute("DB_PART_REV")), Part)
Dim partLoadStatus1 As PartLoadStatus
Dim status1 As PartCollection.SdpsStatus
status1 = theSession.Parts.SetDisplay(Part1, True, True, partLoadStatus1)
CreateCroppedNxScreenshot()
partLoadStatus1.Dispose()
End If
reportComponentChildren(child, indent + 1, xlsWorkSheet)
On Error GoTo 0
End If
Next
lngLevelStart(indent) = 0
End Sub
'**********************************************************
Public Function GetUnloadOption(ByVal dummy As String) As Integer
Return Session.LibraryUnloadOption.Immediately
End Function
'**********************************************************
Sub CreateCroppedNxScreenshot()

'Create a JPG screenshot ###################
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display

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 = False
displayPart.Preferences.NamesBorderVisualization.ShowModelViewBorders = False
'Trimetric view
displayPart.ModelingViews.WorkView.Orient(NXOpen.View.Canned.Trimetric, NXOpen.View.ScaleAdjustment.Fit)
'Hide datums and sketches
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 = strPicFilesPath & displayPart.FullPath & ".jpg"

'Create the image
ufs.Disp.CreateImage(prtJpg, UFDisp.ImageFormat.Jpeg, UFDisp.BackgroundColor.White)
'End Create a JPG screenshot ###################

' Create a new bitmap.
Dim bmp As New Bitmap(prtJpg)

' Lock the bitmap's bits.
Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
Dim bmpData As System.Drawing.Imaging.BitmapData = bmp.LockBits(rect, Drawing.Imaging.ImageLockMode.ReadOnly, bmp.PixelFormat)

' Get the address of the first line.
Dim ptr As IntPtr = bmpData.Scan0

' Declare an array to hold the bytes of the bitmap.
' This code is specific to a bitmap with 24 bits per pixels.
Dim bytes As Integer = Math.Abs(bmpData.Stride) * bmp.Height
Dim rgbValues(bytes - 1) As Byte
Dim intStartRow As Integer
Dim intStartCol As Integer
Dim blnFoundPixel As Boolean = False
Dim x As Integer
Dim y As Integer
Dim cropTop As Integer
Dim cropBottom As Integer
Dim cropLeft As Integer
Dim cropRight As Integer
Dim cropWidth As Integer
Dim cropHeight As Integer
Dim thumbWidth As Integer = 200
Dim thumbHeight As Integer = 200
Dim resizeWidth As Integer
Dim resizeHeight As Integer

' Copy the RGB values into the array.
System.Runtime.InteropServices.Marshal.Copy(ptr, rgbValues, 0, bytes)

'Loop through from top
For y = 0 To bmp.Height - 1
intStartRow = y * Math.Abs(bmpData.Stride)
For x = intStartRow To intStartRow + (bmp.Width - 1) * 3 Step 3
If rgbValues(x) = 255 And rgbValues(x + 1) = 255 And rgbValues(x + 2) = 255 Then
Else
cropTop = y - 2
If cropTop < 0 Then cropTop = 0
blnFoundPixel = True
Exit For
End If
Next
If blnFoundPixel Then Exit For
Next

If Not blnFoundPixel Then
'This is a completely white image
cropTop = 0
cropBottom = bmp.Height
cropLeft = 0
cropRight = bmpData.Width
Else
'Check from the other directions

'Loop through from bottom
blnFoundPixel = False
For y = bmp.Height - 1 To 0 Step -1
intStartRow = y * Math.Abs(bmpData.Stride)
For x = intStartRow To intStartRow + (bmp.Width - 1) * 3 Step 3
If rgbValues(x) = 255 And rgbValues(x + 1) = 255 And rgbValues(x + 2) = 255 Then
Else
cropBottom = y + 2
If cropBottom > bmp.Height - 1 Then cropBottom = bmp.Height - 1
blnFoundPixel = True
Exit For
End If
Next
If blnFoundPixel Then Exit For
Next

'Loop through from left
blnFoundPixel = False
For x = 0 To bmpData.Width - 1
intStartCol = x * 3
For y = intStartCol To rgbValues.Length - 1 Step Math.Abs(bmpData.Stride)
If rgbValues(y) = 255 And rgbValues(y + 1) = 255 And rgbValues(y + 2) = 255 Then
Else
cropLeft = x - 2
If cropLeft < 0 Then cropLeft = 0
blnFoundPixel = True
Exit For
End If
Next
If blnFoundPixel Then Exit For
Next

'Loop through from right
blnFoundPixel = False
For x = bmpData.Width - 1 To 0 Step -1
intStartCol = x * 3
For y = intStartCol To rgbValues.Length - 1 Step Math.Abs(bmpData.Stride)
If rgbValues(y) = 255 And rgbValues(y + 1) = 255 And rgbValues(y + 2) = 255 Then
Else
cropRight = x + 2
If cropRight > bmpData.Width - 1 Then cropRight = bmpData.Width - 1
blnFoundPixel = True
Exit For
End If
Next
If blnFoundPixel Then Exit For
Next
End If

' Unlock the bits.
bmp.UnlockBits(bmpData)

' Crop the white space from around the image
cropWidth = cropRight - cropLeft
cropHeight = cropBottom - cropTop
Dim cropRect As New Rectangle(cropLeft, cropTop, cropWidth, cropHeight)
Dim cropBmp As New Bitmap(cropWidth, cropHeight)
cropBmp = bmp.Clone(cropRect, bmp.PixelFormat)

' Resize the image to required thumbnail size (maintaining aspect ratio)
If cropWidth / thumbWidth > cropHeight / thumbHeight Then
resizeWidth = thumbWidth
resizeHeight = CInt(thumbWidth * cropHeight / cropWidth)
Else
resizeHeight = thumbHeight
resizeWidth = CInt(thumbHeight * cropWidth / cropHeight)
End If

bmp.Dispose()

' Save the resized image
Using OriginalImage As Image = cropBmp
Using ResizedImage As New Bitmap(OriginalImage, resizeWidth, resizeHeight)
ResizedImage.Save(prtJpg, Drawing.Imaging.ImageFormat.Jpeg)
End Using
End Using

cropBmp.Dispose()
End Sub

End Module

Tags: 
Excel
BOM
export screenshot
crop picture

Comments

leozuchetto@yah... - Wed, 10/08/2014 - 03:00

Hello

I´ve tried to run the code, but I got a Journal Execution Error

System.InvalidOperationException: File XXXXXXXXXXX/X is not a valid file name.
at System.Windows.Forms.SaveFileDialog.RunFileDialog(OPENFILENMAE_I ofn)
at System.Windows.Forms.FileDialog.RunDialogOld(IntPtr hWndOwner)
at System.Windows.Forms.CommonDialog.ShowDialog(IWin32Window owner)
at BomToExcel.Main() in C:\Users\XXXXXXX\AppData\Local\Temp\NXJournals10992\journal.vb:line 86

where the first obliterated code XXXXXXXXXXX/X is the name of the file that I am working at and the second obliterated code XXXXXXX is the name of my login at my system.

I´m using NX 6.0.

NXJournaling - Wed, 10/08/2014 - 05:29

Do you happen to be using Teamcenter? The slash character is not allowed in a file name, but is often used in the TC part name. The journal will try to use the part name to create a new Excel file, if you are using TC it may lead to this error.

I'll look into adding a TC check...

NXJournaling - Wed, 10/08/2014 - 14:00

The code below should run in a native or TC environment. If you get errors, please leave a comment below with the error message. Thanks.

Updated June 8, 2015

'####################################################################
' 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 System.Collections.Generic
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
Private _notLoaded As New List(Of String)

Sub Main()
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("")
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

'Allow the user to create a new excel file or add to an existing one.
Dim SaveFileDialog1 As New SaveFileDialog
With SaveFileDialog1
.Title = "Save BoM to Excel File"
.InitialDirectory = "Z:\NX Macros"
.Filter = "Excel files (*.xlsx)|*.xlsx|Macro enabled Excel files (*.xlsm)|*.xlsm|All files (*.*)|*.*"
.FilterIndex = 1
.RestoreDirectory = True
.OverwritePrompt = False
.FileName = (dispPart.ComponentAssembly.RootComponent.DisplayName).Replace("/", "_")
If .ShowDialog() = DialogResult.OK Then
excelFileName = .FileName
lg.WriteLine("Excel file name specified: " & .FileName)
Else
lg.WriteLine("SaveFileDialog1: user pressed cancel, journal exiting")
Exit Sub
End If
End With

'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("/", "_")
lg.WriteLine("processing assembly file")
lg.WriteLine(" display name: " & c.RootComponent.DisplayName)
lg.WriteLine(" rootDispName: " & rootDispName)
lg.WriteLine("")
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
If Not File.Exists(strPicFilesPath & rootDispName & ".jpg") Then
lg.WriteLine(" screenshot does not exist, creating: " & strPicFilesPath & rootDispName & ".jpg")
CreateCroppedNxScreenshot()
Else
lg.WriteLine(" screenshot exists, using: " & strPicFilesPath & rootDispName & ".jpg")
End If
lg.WriteLine(" calling reportComponentChildren(" & c.RootComponent.DisplayName & ", 1, objWorksheet)")
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)
lg.WriteLine("process root component error: ")
lg.WriteLine(" " & e.Message)
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

If _notLoaded.Count > 0 Then
lw.WriteLine("Warning: BOM information is incomplete!")
lw.WriteLine("The following components could not be loaded:")
For Each compName As String In _notLoaded
lw.WriteLine(" " & compName)
Next
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("")

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)

If Not LoadComponent(comp) Then
Return
End If

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

lg.WriteLine(" comp.DisplayName: " & comp.DisplayName)
lg.WriteLine(" compDispName: " & compDispName)

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("/", "_")

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

Dim searchRange As Object = Nothing
Dim foundRange As Object = Nothing
Dim lngFoundInRow As Long = -1
Dim doSearch As Boolean = False

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

lg.WriteLine(" doSearch = " & doSearch.ToString)
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
lg.WriteLine(" new quantity: " & (xlsWorkSheet.cells(lngFoundInRow, colQuantity).Value).ToString)
lg.WriteLine("")
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
If Not File.Exists(strPicFilesPath & childDispName & ".jpg") Then

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)
If child.GetNonGeometricState OrElse child.IsSuppressed Then
'if .GetNonGeometricState = True, comp is set as 'non-geometric'
'skip screenshot
Else
CreateCroppedNxScreenshot()
End If
partLoadStatus1.Dispose()
Else
lg.WriteLine(" screenshot exists, using: " & strPicFilesPath & childDispName & ".jpg")
End If
lg.WriteLine("")
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()

lg.WriteLine("CreateCroppedNxScreenshot")
lg.WriteLine(" timestamp: " & Now)

'Create a JPG screenshot ###################
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display

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 = False
displayPart.Preferences.NamesBorderVisualization.ShowModelViewBorders = False
'Trimetric view
displayPart.ModelingViews.WorkView.Orient(NXOpen.View.Canned.Trimetric, NXOpen.View.ScaleAdjustment.Fit)
'Hide datums and sketches
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 = strPicFilesPath & displayPart.FullPath & ".jpg"
Dim prtJpg As String = strPicFilesPath & displayPart.Leaf & ".jpg"

'Create the image
ufs.Disp.CreateImage(prtJpg, UFDisp.ImageFormat.Jpeg, UFDisp.BackgroundColor.White)
'End Create a JPG screenshot ###################

' Create a new bitmap.
Dim bmp As New Bitmap(prtJpg)

' Lock the bitmap's bits.
Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
Dim bmpData As System.Drawing.Imaging.BitmapData = bmp.LockBits(rect, Drawing.Imaging.ImageLockMode.ReadOnly, bmp.PixelFormat)

' Get the address of the first line.
Dim ptr As IntPtr = bmpData.Scan0

' Declare an array to hold the bytes of the bitmap.
' This code is specific to a bitmap with 24 bits per pixels.
Dim bytes As Integer = Math.Abs(bmpData.Stride) * bmp.Height
Dim rgbValues(bytes - 1) As Byte
Dim intStartRow As Integer
Dim intStartCol As Integer
Dim blnFoundPixel As Boolean = False
Dim x As Integer
Dim y As Integer
Dim cropTop As Integer
Dim cropBottom As Integer
Dim cropLeft As Integer
Dim cropRight As Integer
Dim cropWidth As Integer
Dim cropHeight As Integer
Dim thumbWidth As Integer = 200
Dim thumbHeight As Integer = 200
Dim resizeWidth As Integer
Dim resizeHeight As Integer

' Copy the RGB values into the array.
System.Runtime.InteropServices.Marshal.Copy(ptr, rgbValues, 0, bytes)

'Loop through from top
For y = 0 To bmp.Height - 1
intStartRow = y * Math.Abs(bmpData.Stride)
For x = intStartRow To intStartRow + (bmp.Width - 1) * 3 Step 3
If rgbValues(x) = 255 And rgbValues(x + 1) = 255 And rgbValues(x + 2) = 255 Then
Else
cropTop = y - 2
If cropTop < 0 Then cropTop = 0
blnFoundPixel = True
Exit For
End If
Next
If blnFoundPixel Then Exit For
Next

If Not blnFoundPixel Then
'This is a completely white image
cropTop = 0
'cropBottom = bmpData.Height
cropBottom = thumbHeight
cropLeft = 0
'cropRight = bmpData.Width
cropRight = thumbWidth
Else
'Check from the other directions

'Loop through from bottom
blnFoundPixel = False
For y = bmp.Height - 1 To 0 Step -1
intStartRow = y * Math.Abs(bmpData.Stride)
For x = intStartRow To intStartRow + (bmp.Width - 1) * 3 Step 3
If rgbValues(x) = 255 And rgbValues(x + 1) = 255 And rgbValues(x + 2) = 255 Then
Else
cropBottom = y + 2
If cropBottom > bmp.Height - 1 Then cropBottom = bmp.Height - 1
blnFoundPixel = True
Exit For
End If
Next
If blnFoundPixel Then Exit For
Next

'Loop through from left
blnFoundPixel = False
For x = 0 To bmpData.Width - 1
intStartCol = x * 3
For y = intStartCol To rgbValues.Length - 1 Step Math.Abs(bmpData.Stride)
If rgbValues(y) = 255 And rgbValues(y + 1) = 255 And rgbValues(y + 2) = 255 Then
Else
cropLeft = x - 2
If cropLeft < 0 Then cropLeft = 0
blnFoundPixel = True
Exit For
End If
Next
If blnFoundPixel Then Exit For
Next

'Loop through from right
blnFoundPixel = False
For x = bmpData.Width - 1 To 0 Step -1
intStartCol = x * 3
For y = intStartCol To rgbValues.Length - 1 Step Math.Abs(bmpData.Stride)
If rgbValues(y) = 255 And rgbValues(y + 1) = 255 And rgbValues(y + 2) = 255 Then
Else
cropRight = x + 2
If cropRight > bmpData.Width - 1 Then cropRight = bmpData.Width - 1
blnFoundPixel = True
Exit For
End If
Next
If blnFoundPixel Then Exit For
Next
End If

' Unlock the bits.
bmp.UnlockBits(bmpData)

' Crop the white space from around the image
cropWidth = cropRight - cropLeft
cropHeight = cropBottom - cropTop
Dim cropRect As New Rectangle(cropLeft, cropTop, cropWidth, cropHeight)
Dim cropBmp As New Bitmap(cropWidth, cropHeight)
cropBmp = bmp.Clone(cropRect, bmp.PixelFormat)

' Resize the image to required thumbnail size (maintaining aspect ratio)
If cropWidth / thumbWidth > cropHeight / thumbHeight Then
resizeWidth = thumbWidth
resizeHeight = CInt(thumbWidth * cropHeight / cropWidth)
Else
resizeHeight = thumbHeight
resizeWidth = CInt(thumbHeight * cropWidth / cropHeight)
End If

bmp.Dispose()

' Save the resized image
Using OriginalImage As Image = cropBmp
Using ResizedImage As New Bitmap(OriginalImage, resizeWidth, resizeHeight)
ResizedImage.Save(prtJpg, Drawing.Imaging.ImageFormat.Jpeg)
End Using
End Using

cropBmp.Dispose()

lg.WriteLine("Exiting screenshot subroutine")
lg.WriteLine(" timestamp: " & Now)
lg.WriteLine("")

End Sub

Private Function LoadComponent(ByVal theComponent As Component) As Boolean

lg.WriteLine("Sub LoadComponent()")

Dim thePart As Part = theComponent.Prototype.OwningPart

Dim partName As String = ""
Dim refsetName As String = ""
Dim instanceName As String = ""
Dim origin(2) As Double
Dim csysMatrix(8) As Double
Dim transform(3, 3) As Double

Try
If thePart.IsFullyLoaded Then
'component is fully loaded
Else
'component is partially loaded
End If
lg.WriteLine(" component: " & theComponent.DisplayName & " is already partially or fully loaded")
lg.WriteLine(" return: True")
lg.WriteLine("exiting Sub LoadComponent()")
lg.WriteLine("")
Return True
Catch ex As NullReferenceException
'component is not loaded
Try
lg.WriteLine(" component not loaded, retrieving part information")
ufs.Assem.AskComponentData(theComponent.Tag, partName, refsetName, instanceName, origin, csysMatrix, transform)
lg.WriteLine(" component part file: " & partName)

Dim theLoadStatus As PartLoadStatus
theSession.Parts.Open(partName, theLoadStatus)

If theLoadStatus.NumberUnloadedParts > 0 Then
If theLoadStatus.NumberUnloadedParts > 1 Then
lg.WriteLine(" problem loading " & theLoadStatus.NumberUnloadedParts.ToString & " components")
Else
lg.WriteLine(" problem loading 1 component")
End If

Dim allReadOnly As Boolean = True
For i As Integer = 0 To theLoadStatus.NumberUnloadedParts - 1
lg.WriteLine("part name: " & theLoadStatus.GetPartName(i))
lg.WriteLine("part status: " & theLoadStatus.GetStatus(i))
If theLoadStatus.GetStatus(i) = 641058 Then
'read-only warning, file loaded ok
Else
'641044: file not found
allReadOnly = False
If Not _notLoaded.Contains(partName) Then
_notLoaded.Add(partName)
End If
End If
lg.WriteLine("status description: " & theLoadStatus.GetStatusDescription(i))
lg.WriteLine("")
Next
If allReadOnly Then
lg.WriteLine(" 'read-only' warnings only")
lg.WriteLine(" return: True")
Return True
Else
'warnings other than read-only...
lg.WriteLine(" return: False")
lg.WriteLine("exiting Sub LoadComponent()")
lg.WriteLine("")
Return False
End If
Else
lg.WriteLine(" component(s) loaded successfully")
lg.WriteLine(" return: True")
lg.WriteLine("exiting Sub LoadComponent()")
lg.WriteLine("")
Return True
End If

Catch ex2 As NXException
lg.WriteLine(" Load error: " & ex2.Message)
lg.WriteLine(" error code: " & ex2.ErrorCode)
lg.WriteLine(" return: False")
lg.WriteLine("exiting Sub LoadComponent()")
lg.WriteLine("")
If ex2.Message.ToLower = "file not found" Then
If Not _notLoaded.Contains(partName) Then
_notLoaded.Add(partName)
End If
End If
Return False
End Try
Catch ex As NXException
'unexpected error
lg.WriteLine(" Error in Sub LoadComponent: " & ex.Message)
lg.WriteLine(" return: False")
lg.WriteLine("exiting Sub LoadComponent()")
lg.WriteLine("")
Return False
End Try

End Function

End Module

leozuchetto@yah... - Fri, 10/10/2014 - 02:59

Ues, I´m using it in a TC Environment. I´ve tried this code, but it failed. So in the line where is the following code ".FileName = dispPart.ComponentAssembly.RootComponent.DisplayName" I have deleted everything after the equal symbol and replaced to any text, in the case, my name.
The code runned and generated a excel file with the structure of my assembly.
But it haven´t generated any images.

NXJournaling - Fri, 10/10/2014 - 06:38

What delimiter does your TC installation use between the part number and the revision? Is it the forward slash (/), back slash (\), or something else?

12345/A
12345\A
12345_A

NXJournaling - Fri, 10/10/2014 - 07:50

The code above was updated to remove the forward slash from TC part/component names. Re-download the code and try again; please report any errors as I don't have TC to test with.

leozuchetto@yah... - Fri, 10/10/2014 - 10:54

I ran the code again and worked very well removing the slash from the parts names. But the excel file that is generated still do not have any pictures in it. Not only the assembly names have a slash, but the parts too. Can this info be part of the error that none image is being attached to the excel file?

NXJournaling - Fri, 10/10/2014 - 11:57

When I modified the code, I also tried to remove the slashes from the component names (and the corresponding picture file names) as well, though I may have missed something. I'll take another look.

The screenshots should end up in the C:\partimages folder; does anything get created in this folder for you?

Also, what version of NX and Excel are you running?

leozuchetto@yah... - Mon, 10/13/2014 - 04:20

All the images are saved in this folder you mentioned. I´m using NX 6.0.5.3 and Excel 2010, version 14.

ian.eldred - Mon, 10/13/2014 - 05:32

Do they match the ID column in the spreadsheet or has the Windows OS stripped some characters?

Also, there is a difference between the way Excel 2010 implements the line objWorksheet.Pictures.Insert(strFileName) and the Excel 2007 implementation. I can't test it with 2010, but I've read that it only inserts a link to the file, not the image itself. This line may need to be replaced with Shapes.AddPicture, but I'm sure I tried that first and it was much more difficult to implement!

leozuchetto@yah... - Mon, 10/13/2014 - 11:22

It matches perfectly. But the names of the images does not have the slash in the names.

leozuchetto@yah... - Fri, 10/17/2014 - 06:42

I´ve tried to replace the line, but I got an error.
Is there anything missing in the line code?

uwe.a - Sun, 10/19/2014 - 01:10

Hi, to add some comlexity,
this is like nice bom output.
How would you sort the output to an attribute or the callout numbers, output to excel.
any idas wellcome
thanks in advance

aaron montenegro - Tue, 10/21/2014 - 15:17

hello everyone i try to use this journal but i have problems
some one can help me to export only the bomview

aaron montenegro

Drew Jones - Wed, 10/29/2014 - 05:48

I ran it in NX 9.0.2.5 Native and it worked well. 2 comments:
1) It seems to choke when it hits a part without geometry.
2) Column F is unlabeled and can't quite figure out what that is.

This is astonishing code. I'm going to spend way more time than I should studying it. Thanks for posting it.

Drew

Drew Jones - Wed, 10/29/2014 - 11:33

Well, it worked fine first time, but working on another assembly it chokes with this cryptic error message:
System.Runtime.InteropServices.COMException: Exception from HRESULT: 0x800A03EDC
at Microsoft.VisualBasic.CompilerServices.LateBinding.LateGet(Object o, Type objType, String name, Object[] args, String[]
paramnames, Boolean[] CopyBack)
at BomToExcel.Maine() in C:\Users\XXXXX\AppData\Local\Temp\1\NXJournals9160\journal.vb:line 261

Drew

NXJournaling - Wed, 11/05/2014 - 05:41

I've tweaked the code a little bit in the comment dated 10/8/2014. If you ran the code previously and you didn't get a complete BOM, or NX froze, please download the new version and try again.

If you have issues with the new version, please leave a comment with a description along with your NX and Excel version.

gdonohoo - Thu, 12/11/2014 - 21:13

Firstly let me commend this piece of code - it is very easy to read, well commented in the source and has useful debugging output in the logfile.I've benefitted much already from looking at how it was constructed.

I'm running it in TCe environment and using NX7.5. and the images are not appearing in the excel file for me either. We use a "/" as the seperater character between the number and revision.

When I look in the C:\partimages folder, the image files have no revision in their filename. (eg a part file called "40000000/--" in teamcenter is being given the ID of 40000000_--, yet the image is being called 40000000.jpg)

For teamcenter users (using the "/" seperater), the problem is in the CreateCroppedNXScreenshot sub, which
has the line:-

Dim prtJpg As String = strPicFilesPath & displayPart.Leaf & ".jpg

This really should be wrapped into a check for teamcenter loop (as appears in earlier subs) , however if the line was editied as below then the images will get the correct name - substituting the "/" with a "_"

Dim prtJpg As String = strPicFilesPath & displayPart.FullPath.Replace("/", "_") & ".jpg"

I had a quick try at putting the loop into that sub but it errored out when I tried to run it (suspect the IsTcEng variable is not being passed through. Here's what I tried


'Set the filename
If IsTcEng Then
Dim prtJpg As String = strPicFilesPath & displayPart.FullPath.Replace("/", "_") & ".jpg"
Else
Dim prtJpg As String = strPicFilesPath & displayPart.Leaf & ".jpg"
End If

NXJournaling - Fri, 12/12/2014 - 07:28

The IsTcEng variable is essentially a global variable, the subroutine has access to it. The problem is that the prtJpg variable has been declared within the If block; this limits the scope of the variable to the If block, outside of the If block, the variable does not exist.

Try declaring the variable outside of the If block and assigning the value in the If block like this:

Dim prtJpg as String

If IsTcEng Then
prtJpg = strPicFilesPath & displayPart.FullPath.Replace("/", "_") & ".jpg"
Else
prtJpg = strPicFilesPath & displayPart.Leaf & ".jpg"
End If

gdonohoo - Sun, 12/14/2014 - 15:03

Thanks, that did the trick (and progressed my learning along too).

shawn.t.jones - Tue, 02/03/2015 - 12:45

Hello,

I was wondering if anyone can help explain how to add a column that would pull string data from another property in the NX file. Also, how to increase the image size?

Thanks, Shawn

NXJournaling - Wed, 02/04/2015 - 08:57

I believe the image size is controlled by:

Dim thumbWidth As Integer = 200
Dim thumbHeight As Integer = 200

Joshua39 - Fri, 02/13/2015 - 11:39

Apparently this Journal File was not written in the context of Teamcenter. I tried it on an NX Assembly in Teamcenter and the Journal files did not execute.
Any chance it could re-written in a Teamcenter environment?

JP

NXJournaling - Fri, 02/13/2015 - 12:04

The author, Ian Eldred, notes that it was written for NX 7.5 with Teamcenter. I had a few problems with the original code, as I was running native NX; and I made a few tweaks to get it to work for me (the 2nd code listing in the comments). I may have inadvertently introduced one or more bugs for TC users; or it may be that your NX, TC, and Excel versions are different than what the original journal targeted. I'd bet there are some specific TC settings that could affect the output of the journal. Also, what version(s) of the .net framework you have installed can play a part.

What version of NX, TC, and Excel are you using?
Do you get any error messages when attempting to run the journal? If so, what are they?
Can you email a copy of your log file after attempting to run the journal? Please edit the log file and only include the line that reads: "~~~~ Start of BomToExcel journal ~~~~" to the end of the file. There is some stuff at the top of the file that is potentially sensitive information, which I don't need or want. You can email it to: info@nxjournaling.com

Thanks

shawn.t.jones - Fri, 02/20/2015 - 14:07

Hi,

I am trying to change the journal to pull different properties than the part name. The property is from part attributes in the displayed part properties menu, or can be found in the information window under routing characteristics, its called CDBI_PART_NUMBER. When I tried to replace the code, I got an error that said: CDBI_PART_NUMBER is not a member of 'NXOpen.INXObject'. I am not sure if I am changing the right lines, or writing the code correctly to pull that property.

If anyone could help I'd greatly appreciate that.

sbertaux - Wed, 03/04/2015 - 05:34

Hello,
I tried this journal with NX8.5.3, no problem to export the BOM and the associated pictures. But when I launch it in NX connected to Teamcenter8, it doesn't work. At first, there is a message in NX which is "No write access" ( under the toolbar ). After a few minutes(20-30), I have another error message (Journal execution error): System.argumentNullEception:Value cannot be null. Parameter name: Argument 'Number' is Nothing.......
Could anyone help me to resolv this problem
Thank You

SBertaux

myspambox999 - Wed, 06/15/2016 - 03:52

I had the same problem and I believe in my case it was down to the revision slash in the part number. See the code in the long comment above which is modified to take out the slashs' in the part numbers. hope this helps :)

pfillion - Mon, 03/09/2015 - 07:05

Does anyone know how long this program runs? I seem to be just getting the work in process box. How long should this take?

Paul Fillion

NXJournaling - Tue, 03/10/2015 - 06:55

Creating the screenshots seems to take the most time. The more unique components in the assembly, the longer it will take. I tested on a small assembly (~70 unique components) and it only took a few minutes to finish.

rnewcomb - Thu, 08/20/2015 - 05:34

could this be modified to add the columns on the ANT?

NXJournaling - Thu, 08/20/2015 - 06:23

Unfortunately, the journal cannot read the current state of the ANT and automatically add columns as necessary. The API does not give us access to the ANT (at least of NX 9; I've not checked NX 10, but I doubt it has been added); we cannot query the ANT to see what columns the user has set up.

Timmey - Fri, 04/29/2016 - 00:00

I've been reworking this nx journal, which is awesome btw, but i've been stuck with a strange error in determining the quantity. If the same subassembly (imported Bosch hinge, 2 parts) is in different assemblies on different levels, the resulting excel file shows that the first instance of the assembly has all if not most parts, every other instance has only 1 part (alternating between the 2).

Would it be possible to limit the part search for determining the quantity to the current level and would this solve the problem?

Many Thanks!

Tim

myspambox999 - Wed, 06/15/2016 - 03:49

Is there a way to leave out all entires that are suppressed. At the moment my code won't run if there are any in my assembly.

NXJournaling - Wed, 06/15/2016 - 05:41

A component object has an .IsSuppressed property that will return True/False depending on the state of the component.