录制vb之文件转换
转自http://www.nxjournaling.com/content/batch-export-prt-stl
1、单个文件*.vb
Option Strict Off
Imports System
Imports System.Collections.Generic
Imports NXOpen
Imports NXOpen.UF
Module Module1
Dim theSession As Session = Session.GetSession()
Dim theUfSession As UFSession = UFSession.GetUFSession()
Dim lw As ListingWindow = theSession.ListingWindow
Sub Main()
If IsNothing(theSession.Parts.BaseWork) Then
'active part required
Return
End If
Dim workPart As Part = theSession.Parts.Work
lw.Open()
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
lw.Close()
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 immediately after execution within NX
GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately
End Function
End Module2、文件夹内的所有文件
Option Strict Off
Imports System
Imports System.IO
Imports System.Collections.Generic
Imports System.Windows.Forms
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
End Module