Export assembly to Excel with pictures

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