录制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 Module

2、文件夹内的所有文件

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