Batch Export from .prt to .stl

Imports NXOpen
Imports NXOpenUI
Imports NXOpen.UF

Module Cycle_Files_and_Folders_b
Dim theSession As Session = Session.GetSession
Dim theUfSession As UFSession = UFSession.GetUFSession()
Dim LW As ListingWindow = theSession.ListingWindow

Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim initialPart As Part = theSession.Parts.Display

Dim nTotalPartFiles As Integer = 0

Sub Main()

Dim strOutputFolder As String
LW.Open()
Try

Dim FolderBrowserDialog1 As New FolderBrowserDialog
' Change the .SelectedPath property to the default location
With FolderBrowserDialog1
' Desktop is the root folder in the dialog.
.RootFolder = Environment.SpecialFolder.Desktop
' Change the following line to default to a given path
.SelectedPath = "C:\"
' Prompt the user with a custom message.
.Description = "Select the directory to scan"
If .ShowDialog = DialogResult.OK Then
' Display the selected folder if the user clicked on the OK button.
'msgbox(.SelectedPath)
strOutputFolder = .SelectedPath
Else
'user pressed "cancel", exit the journal
Exit Sub
End If
End With

LW.WriteLine("Cycle All Parts in a Folder Tree")
LW.WriteLine("Start Time: " & CType(TimeOfDay(), String))
LW.WriteLine("")

processParts(strOutputFolder, False)

LW.WriteLine("")
LW.WriteLine("Total Part Files Scanned: " & nTotalPartFiles)
LW.WriteLine("Stop Time: " & CType(TimeOfDay(), String))

Catch ex As NXException
LW.WriteLine("Cycle Files and Folders Error: " & ex.Message)
Exit Sub
End Try
End Sub

'***************************************************************************
'Process All Parts in a Directory

Sub processParts(ByVal directoryPath As String, ByVal includeSubDirs As Boolean)

Try
Dim nPartFiles As Integer = 0
Dim part1 As Part
Dim files() As String

If includeSubDirs Then
files = Directory.GetFiles(directoryPath, "*.prt", SearchOption.AllDirectories)
Else
files = Directory.GetFiles(directoryPath, "*.prt", SearchOption.TopDirectoryOnly)
End If
For Each fileName As String In files
nPartFiles += 1
nTotalPartFiles += 1
LW.WriteLine(" " & nPartFiles & " " & Path.GetFileName(fileName))

If (IsNothing(initialPart)) OrElse (initialPart.FullPath <> fileName) Then
part1 = theSession.Parts.OpenDisplay(fileName, Nothing)
Else
'LW.WriteLine("initial part equals display part: " & initialPart.Equals(displayPart).ToString)
part1 = displayPart
End If

displayPart = theSession.Parts.Display
workPart = theSession.Parts.Display

'do something
'write your own subroutines and/or functions to process the part and call them from here

Const undoMarkName As String = "export solids to STL"
Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Invisible, undoMarkName)

Dim theSolids As New List(Of Body)

'collect the solid bodies in the work part
For Each temp As Body In workPart.Bodies
If temp.IsSolidBody Then
theSolids.Add(temp)
End If
Next

Try
ExportSTL(workPart.FullPath, theSolids, 0.003, 0.003)
Catch ex As NXException
LW.WriteLine("NX Error: " & ex.Message)
Catch ex As Exception
LW.WriteLine("Error: " & ex.Message)
End Try

'close file unless this file was initially open
If (IsNothing(initialPart)) OrElse (initialPart.FullPath <> fileName) Then
'part1.Save(BasePart.SaveComponents.True, BasePart.CloseAfterSave.True)
part1.Close(BasePart.CloseWholeTree.False, BasePart.CloseModified.UseResponses, Nothing)
part1 = Nothing
workPart = Nothing
displayPart = Nothing
End If

If Not IsNothing(initialPart) Then
Dim partLoadStatus1 As PartLoadStatus
Dim status1 As PartCollection.SdpsStatus
status1 = theSession.Parts.SetDisplay(initialPart, False, False, partLoadStatus1)

displayPart = theSession.Parts.Display
partLoadStatus1.Dispose()
theSession.Parts.SetWork(displayPart)
workPart = theSession.Parts.Work
End If

Next fileName
Catch ex As Exception
LW.WriteLine("Part Scan Error: " & ex.Message)
End Try

End Sub

'***************************************************************************
Sub ExportSTL(ByVal FileName As String, ByVal theObjects As List(Of Body), ByVal triangleTolerance As Double, ByVal adjacencyTolerance As Double)

Dim NumErrors As Integer
Dim FileHandle As IntPtr
Dim InfoError() As UFStd.StlError
Dim Header, FileBaseName As String
'Dim numNegated As Integer
'Dim Negated() As Tag

'Negated = Nothing
InfoError = Nothing

FileName = IO.Path.ChangeExtension(FileName, ".stl")

FileBaseName = IO.Path.GetFileName(FileName)
Header = "Header: " & FileBaseName

theUfSession.Std.OpenBinaryStlFile(FileName, False, Header, FileHandle)

theUfSession.Ui.SetPrompt("Creating file ... " & FileBaseName & " ...")

For Each temp As Body In theObjects
If temp.IsSolidBody Then
theUfSession.Std.PutSolidInStlFile(FileHandle, Tag.Null, temp.Tag, 0.0, 0.0, triangleTolerance, NumErrors, InfoError)
End If
Next

theUfSession.Std.CloseStlFile(FileHandle)

theUfSession.Ui.SetStatus("File ... " & FileBaseName & " generated ...")

End Sub

'***********************************************************************

Public Function GetUnloadOption(ByVal dummy As String) As Integer

'Unloads the image when the NX session terminates
GetUnloadOption = NXOpen.Session.LibraryUnloadOption.AtTermination

End Function