-
1
- #1
Buitung
Mechanical
- Oct 1, 2024
- 1
After spending some time reading articles and watching instructional videos on YouTube, I have written a code that can automatically take photos and export the measurement results to an Excel file. I hope this will help you save time at work, and it's also my way of saying thank you .I tested it and it works on NX 2312 version.
Imports System
Imports System.IO
Imports System.Collections.Generic
Imports NXOpen
Imports NXOpen.UI
Imports NXOpen.Utilities
Imports NXOpen.UF
Imports Microsoft.VisualBasic.Interaction
Module CombinedModule
' Initialize NX session and get the current part
Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim theUI As UI = UI.GetUI
Dim ufs As UFSession = UFSession.GetUFSession
Dim lw As ListingWindow = theSession.ListingWindow
Sub Main()
lw.Open()
' Input folder containing .prt files
Dim inputDir As String = "C:\Users\KT-SEMICON\Desktop\3D ALL CUSTOMER\"
' Output folder for .jpg and Excel files
Dim outputDir As String = "D:\TEST CODE\"
Dim outputExcelPath As String = Path.Combine(outputDir, "MeasurementResults.xlsm")
' Check if output directory exists, if not, create it
If Not Directory.Exists(outputDir) Then
Directory.CreateDirectory(outputDir)
End If
' Get all .stp files in the input directory
Dim partFiles As String() = Directory.GetFiles(inputDir, "*.stp")
Dim fileCount As Integer = 0
' Open the Excel workbook and the first sheet
Dim excelApp = CreateObject("Excel.Application")
Dim workbook = excelApp.Workbooks.Open("D:\book1.xlsm")
Dim worksheet = workbook.Sheets(1)
excelApp.Visible = False
' Process each part file
For Each partFile As String In partFiles
Try
' Open part file
Dim loadStatus As NXOpen.PartLoadStatus = Nothing
workPart = theSession.Parts.OpenBaseDisplay(partFile, loadStatus)
' Fit the view in the part model
workPart.ModelingViews.WorkView.Fit()
' Calculate dimensions
Dim dimensions As Double() = CalculateDimensions(workPart)
' Generate the image path for the part
Dim fileName As String = Path.GetFileNameWithoutExtension(partFile)
Dim imageName As String = fileName & ".jpg"
Dim imagePath As String = Path.Combine(outputDir, imageName)
' Set up and export the image
ExportToJPEG(workPart, imagePath)
' Export results to Excel
ExportToExcel(worksheet, fileCount + 2, fileName, dimensions, imagePath)
' Close the part file after processing
workPart.Close(BasePart.CloseWholeTree.True, BasePart.CloseModified.UseResponses, Nothing)
' Increment file count
fileCount += 1
Catch ex As Exception
' Display error if any
lw.WriteLine("Error processing file: " & partFile & " - Error: " & ex.Message)
End Try
Next
' Save Excel file with a timestamp
Dim timestamp As String = DateTime.Now.ToString("yyyyMMdd_HHmmss")
workbook.SaveAs(Path.Combine(outputDir, "MeasurementResults_" & timestamp & ".xlsm"))
' Close Excel workbook and the application
workbook.Close(False)
excelApp.Quit()
' Release resources
releaseObject(worksheet)
releaseObject(workbook)
releaseObject(excelApp)
' Show completion message
MsgBox("Completed. Successfully processed " & fileCount.ToString() & " files.")
lw.WriteLine("Completed. Successfully processed " & fileCount.ToString() & " files.")
lw.Close()
End Sub
' Function to calculate part dimensions
Function CalculateDimensions(ByVal workPart As Part) As Double()
Dim MybodyList As List(Of Body) = AskAllBodies(workPart)
Dim maxLength As Double = 0
Dim maxWidth As Double = 0
Dim maxHeight As Double = 0
For Each Mybody As Body In MybodyList
Dim lengths As Double() = ProcessBody(Mybody)
maxLength = Math.Max(maxLength, lengths(0))
maxWidth = Math.Max(maxWidth, lengths(1))
maxHeight = Math.Max(maxHeight, lengths(2))
Next
' Sort dimensions in length, width, height order
Dim dimensions As Double() = {maxLength, maxWidth, maxHeight}
Array.Sort(dimensions)
Array.Reverse(dimensions)
Return dimensions
End Function
' Process each body to get bounding box dimensions
Function ProcessBody(ByVal Mybody As Body) As Double()
Dim a_body As NXOpen.Tag = Mybody.Tag
Dim csys As NXOpen.Tag = NXOpen.Tag.Null
Dim min_corner(2) As Double
Dim directions(2, 2) As Double
Dim distances(2) As Double
ufs.Csys.AskWcs(csys)
ufs.Modl.AskBoundingBoxExact(a_body, csys, min_corner, directions, distances)
Return distances
End Function
' Get all solid bodies in the part
Function AskAllBodies(ByVal thePart As Part) As List(Of Body)
Dim theBodies As New List(Of Body)
Try
Dim aBodyTag As Tag = NXOpen.Tag.Null
Do
ufs.Obj.CycleObjsInPart(thePart.Tag, UFConstants.UF_solid_type, aBodyTag)
If aBodyTag = NXOpen.Tag.Null Then Exit Do
Dim theType As Integer, theSubtype As Integer
ufs.Obj.AskTypeAndSubtype(aBodyTag, theType, theSubtype)
If theSubtype = UFConstants.UF_solid_body_subtype Then
theBodies.Add(Utilities.NXObjectManager.Get(aBodyTag))
End If
Loop While True
Catch ex As NXException
lw.WriteLine(ex.ErrorCode & ex.Message)
End Try
Return theBodies
End Function
' Export the part view as a JPEG
Sub ExportToJPEG(ByVal workPart As Part, ByVal imagePath As String)
Dim theSession As NXOpen.Session = NXOpen.Session.GetSession()
Dim markId1 As NXOpen.Session.UndoMarkId = Nothing
markId1 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Visible, "Start")
Dim imageExportBuilder1 As NXOpen.Gateway.ImageExportBuilder = workPart.Views.CreateImageExportBuilder()
imageExportBuilder1.RegionMode = False
imageExportBuilder1.DeviceWidth = 1920
imageExportBuilder1.DeviceHeight = 1080
imageExportBuilder1.FileFormat = NXOpen.Gateway.ImageExportBuilder.FileFormats.Jpg
imageExportBuilder1.FileName = imagePath
imageExportBuilder1.BackgroundOption = NXOpen.Gateway.ImageExportBuilder.BackgroundOptions.CustomColor
' Set background color to white
Dim custombackgroundcolor1(2) As Double
custombackgroundcolor1(0) = 1.0
custombackgroundcolor1(1) = 1.0
custombackgroundcolor1(2) = 1.0
imageExportBuilder1.SetCustomBackgroundColor(custombackgroundcolor1)
' Commit the image export
Dim nXObject1 As NXOpen.NXObject = Nothing
nXObject1 = imageExportBuilder1.Commit()
theSession.DeleteUndoMark(markId1, "Export Image")
imageExportBuilder1.Destroy()
End Sub
' Export the part data and image to Excel
Sub ExportToExcel(ByVal worksheet As Object, ByVal row As Integer, ByVal fileName As String, ByVal dimensions As Double(), ByVal imagePath As String)
Try
' Get unit type from Siemens NX
Dim unitType As String = GetUnitOfMeasure()
' Export file name and dimensions to Excel
worksheet.Cells(row, "B") = fileName ' File name
worksheet.Cells(row, "C") = dimensions(0) ' Length
worksheet.Cells(row, "D") = dimensions(1) ' Width
worksheet.Cells(row, "E") = dimensions(2) ' Height
worksheet.Cells(row, "F") = unitType ' Unit
' Insert the image in cell G2 with size 0.8"x1.25"
Dim pic = worksheet.Pictures.Insert(imagePath)
pic.Left = worksheet.Cells(row, "G").Left
pic.Top = worksheet.Cells(row, "G").Top
pic.Width = 30 ' 0.8 inches in points (1 inch = 72 points)
pic.Height = 60 ' 1.25 inches in points
Catch ex As Exception
MsgBox("Error exporting data to Excel: " & ex.Message)
End Try
End Sub
' Get the unit of measure from Siemens NX
Function GetUnitOfMeasure() As String
Dim unitType As String = "mm" ' Default to mm
Try
If workPart.PartUnits = BasePart.Units.Inches Then
unitType = "in"
ElseIf workPart.PartUnits = BasePart.Units.Millimeters Then
unitType = "mm"
End If
Catch ex As Exception
lw.WriteLine("Error getting unit of measure from Siemens NX: " & ex.Message)
End Try
Return unitType
End Function
Imports System
Imports System.IO
Imports System.Collections.Generic
Imports NXOpen
Imports NXOpen.UI
Imports NXOpen.Utilities
Imports NXOpen.UF
Imports Microsoft.VisualBasic.Interaction
Module CombinedModule
' Initialize NX session and get the current part
Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim theUI As UI = UI.GetUI
Dim ufs As UFSession = UFSession.GetUFSession
Dim lw As ListingWindow = theSession.ListingWindow
Sub Main()
lw.Open()
' Input folder containing .prt files
Dim inputDir As String = "C:\Users\KT-SEMICON\Desktop\3D ALL CUSTOMER\"
' Output folder for .jpg and Excel files
Dim outputDir As String = "D:\TEST CODE\"
Dim outputExcelPath As String = Path.Combine(outputDir, "MeasurementResults.xlsm")
' Check if output directory exists, if not, create it
If Not Directory.Exists(outputDir) Then
Directory.CreateDirectory(outputDir)
End If
' Get all .stp files in the input directory
Dim partFiles As String() = Directory.GetFiles(inputDir, "*.stp")
Dim fileCount As Integer = 0
' Open the Excel workbook and the first sheet
Dim excelApp = CreateObject("Excel.Application")
Dim workbook = excelApp.Workbooks.Open("D:\book1.xlsm")
Dim worksheet = workbook.Sheets(1)
excelApp.Visible = False
' Process each part file
For Each partFile As String In partFiles
Try
' Open part file
Dim loadStatus As NXOpen.PartLoadStatus = Nothing
workPart = theSession.Parts.OpenBaseDisplay(partFile, loadStatus)
' Fit the view in the part model
workPart.ModelingViews.WorkView.Fit()
' Calculate dimensions
Dim dimensions As Double() = CalculateDimensions(workPart)
' Generate the image path for the part
Dim fileName As String = Path.GetFileNameWithoutExtension(partFile)
Dim imageName As String = fileName & ".jpg"
Dim imagePath As String = Path.Combine(outputDir, imageName)
' Set up and export the image
ExportToJPEG(workPart, imagePath)
' Export results to Excel
ExportToExcel(worksheet, fileCount + 2, fileName, dimensions, imagePath)
' Close the part file after processing
workPart.Close(BasePart.CloseWholeTree.True, BasePart.CloseModified.UseResponses, Nothing)
' Increment file count
fileCount += 1
Catch ex As Exception
' Display error if any
lw.WriteLine("Error processing file: " & partFile & " - Error: " & ex.Message)
End Try
Next
' Save Excel file with a timestamp
Dim timestamp As String = DateTime.Now.ToString("yyyyMMdd_HHmmss")
workbook.SaveAs(Path.Combine(outputDir, "MeasurementResults_" & timestamp & ".xlsm"))
' Close Excel workbook and the application
workbook.Close(False)
excelApp.Quit()
' Release resources
releaseObject(worksheet)
releaseObject(workbook)
releaseObject(excelApp)
' Show completion message
MsgBox("Completed. Successfully processed " & fileCount.ToString() & " files.")
lw.WriteLine("Completed. Successfully processed " & fileCount.ToString() & " files.")
lw.Close()
End Sub
' Function to calculate part dimensions
Function CalculateDimensions(ByVal workPart As Part) As Double()
Dim MybodyList As List(Of Body) = AskAllBodies(workPart)
Dim maxLength As Double = 0
Dim maxWidth As Double = 0
Dim maxHeight As Double = 0
For Each Mybody As Body In MybodyList
Dim lengths As Double() = ProcessBody(Mybody)
maxLength = Math.Max(maxLength, lengths(0))
maxWidth = Math.Max(maxWidth, lengths(1))
maxHeight = Math.Max(maxHeight, lengths(2))
Next
' Sort dimensions in length, width, height order
Dim dimensions As Double() = {maxLength, maxWidth, maxHeight}
Array.Sort(dimensions)
Array.Reverse(dimensions)
Return dimensions
End Function
' Process each body to get bounding box dimensions
Function ProcessBody(ByVal Mybody As Body) As Double()
Dim a_body As NXOpen.Tag = Mybody.Tag
Dim csys As NXOpen.Tag = NXOpen.Tag.Null
Dim min_corner(2) As Double
Dim directions(2, 2) As Double
Dim distances(2) As Double
ufs.Csys.AskWcs(csys)
ufs.Modl.AskBoundingBoxExact(a_body, csys, min_corner, directions, distances)
Return distances
End Function
' Get all solid bodies in the part
Function AskAllBodies(ByVal thePart As Part) As List(Of Body)
Dim theBodies As New List(Of Body)
Try
Dim aBodyTag As Tag = NXOpen.Tag.Null
Do
ufs.Obj.CycleObjsInPart(thePart.Tag, UFConstants.UF_solid_type, aBodyTag)
If aBodyTag = NXOpen.Tag.Null Then Exit Do
Dim theType As Integer, theSubtype As Integer
ufs.Obj.AskTypeAndSubtype(aBodyTag, theType, theSubtype)
If theSubtype = UFConstants.UF_solid_body_subtype Then
theBodies.Add(Utilities.NXObjectManager.Get(aBodyTag))
End If
Loop While True
Catch ex As NXException
lw.WriteLine(ex.ErrorCode & ex.Message)
End Try
Return theBodies
End Function
' Export the part view as a JPEG
Sub ExportToJPEG(ByVal workPart As Part, ByVal imagePath As String)
Dim theSession As NXOpen.Session = NXOpen.Session.GetSession()
Dim markId1 As NXOpen.Session.UndoMarkId = Nothing
markId1 = theSession.SetUndoMark(NXOpen.Session.MarkVisibility.Visible, "Start")
Dim imageExportBuilder1 As NXOpen.Gateway.ImageExportBuilder = workPart.Views.CreateImageExportBuilder()
imageExportBuilder1.RegionMode = False
imageExportBuilder1.DeviceWidth = 1920
imageExportBuilder1.DeviceHeight = 1080
imageExportBuilder1.FileFormat = NXOpen.Gateway.ImageExportBuilder.FileFormats.Jpg
imageExportBuilder1.FileName = imagePath
imageExportBuilder1.BackgroundOption = NXOpen.Gateway.ImageExportBuilder.BackgroundOptions.CustomColor
' Set background color to white
Dim custombackgroundcolor1(2) As Double
custombackgroundcolor1(0) = 1.0
custombackgroundcolor1(1) = 1.0
custombackgroundcolor1(2) = 1.0
imageExportBuilder1.SetCustomBackgroundColor(custombackgroundcolor1)
' Commit the image export
Dim nXObject1 As NXOpen.NXObject = Nothing
nXObject1 = imageExportBuilder1.Commit()
theSession.DeleteUndoMark(markId1, "Export Image")
imageExportBuilder1.Destroy()
End Sub
' Export the part data and image to Excel
Sub ExportToExcel(ByVal worksheet As Object, ByVal row As Integer, ByVal fileName As String, ByVal dimensions As Double(), ByVal imagePath As String)
Try
' Get unit type from Siemens NX
Dim unitType As String = GetUnitOfMeasure()
' Export file name and dimensions to Excel
worksheet.Cells(row, "B") = fileName ' File name
worksheet.Cells(row, "C") = dimensions(0) ' Length
worksheet.Cells(row, "D") = dimensions(1) ' Width
worksheet.Cells(row, "E") = dimensions(2) ' Height
worksheet.Cells(row, "F") = unitType ' Unit
' Insert the image in cell G2 with size 0.8"x1.25"
Dim pic = worksheet.Pictures.Insert(imagePath)
pic.Left = worksheet.Cells(row, "G").Left
pic.Top = worksheet.Cells(row, "G").Top
pic.Width = 30 ' 0.8 inches in points (1 inch = 72 points)
pic.Height = 60 ' 1.25 inches in points
Catch ex As Exception
MsgBox("Error exporting data to Excel: " & ex.Message)
End Try
End Sub
' Get the unit of measure from Siemens NX
Function GetUnitOfMeasure() As String
Dim unitType As String = "mm" ' Default to mm
Try
If workPart.PartUnits = BasePart.Units.Inches Then
unitType = "in"
ElseIf workPart.PartUnits = BasePart.Units.Millimeters Then
unitType = "mm"
End If
Catch ex As Exception
lw.WriteLine("Error getting unit of measure from Siemens NX: " & ex.Message)
End Try
Return unitType
End Function