What is the VB code to close NX part file?

[Aredybar]

Hi,

I am a newbie in NX journaling, would like to get some advice on how to close
opened part file.
Seems like the sub part will open 1 by 1, take time for larger assemblies.
Want to autoclose each part after operation done.
Tried almost everything but none run good.

******************************************************************************

' NX 11.0.2.7
' Journal created by ayf0058618 on Fri Aug 02 11:32:34 2024 マレー半島標準時

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 = "D:\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("PDM_Part_No")
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, colDescription).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("PDM_Part_No")
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.Replace("/", "_") & ".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 = 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 = 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

 

[cowski]

Ian's Excel BOM code is fairly complicated. I suggest that you start with something simpler.

In this particular case, I don't think that closing parts will speed anything up.

www.nxjournaling.com

 

[Bleaker]

You can record NX Journals while performing simple tasks to learn how NXOpen does stuff from these.

Recorded Journals tend to get excessively verbose when you record more than a couple simple actions (running the risk of drawing you into cargo-cult programming), but this should be bearable for single isolated commands like "close part".