Option Strict Off
Imports System
Imports System.Collections.Generic
Imports NXOpen
Imports NXOpen.UF
Module Module3
Dim theSession As Session = Session.GetSession()
Dim theUfSession As UFSession = UFSession.GetUFSession()
Dim workPart As Part = theSession.Parts.Work
Dim lw As ListingWindow = theSession.ListingWindow
Sub Main()
lw.Open()
Dim currentPath As String = GetFilePath()
Dim currentFile As String = GetFileName()
Dim pdfFile As String = GetFilePath() & GetFileName() & ".pdf"
Dim dxfFile As String = GetFilePath() & GetFileName() & ".dxf"
Dim partUnits As Integer = theSession.Parts.Display.PartUnits
'0 = inch
'1 = metric
Dim i As Integer = 0
For Each sheet As Drawings.DrawingSheet In theSession.Parts.Display.DrawingSheets
'msgbox (sheet.name)
i = i + 1
'the pdf export uses 'append file', if we are on sheet 1 make sure the user wants to overwrite
'if the drawing is multisheet, don't ask on subsequent sheets
If i = 1 Then
If IO.File.Exists(pdfFile) Then
Dim rspFileExists As System.Windows.Forms.DialogResult
rspFileExists = System.Windows.Forms.MessageBox.Show("The file: '" & pdfFile & "' already exists; overwrite?", "Overwrite file?", System.Windows.Forms.MessageBoxButtons.YesNo, System.Windows.Forms.MessageBoxIcon.Question)
If rspFileExists = System.Windows.Forms.DialogResult.Yes Then
Try
IO.File.Delete(pdfFile)
Catch ex As Exception
System.Windows.Forms.MessageBox.Show(ex.Message & vbCrLf & "Journal exiting", "Error", System.Windows.Forms.MessageBoxButtons.OK, System.Windows.Forms.MessageBoxIcon.Error)
Exit Sub
End Try
Else
'user chose not to overwrite file
'msgbox("journal exiting", vbokonly)
Exit Sub
End If
End If
End If
Try
ExportPDF(sheet, pdfFile, partUnits)
Catch ex As Exception
MsgBox("Error occurred in PDF export" & vbCrLf & ex.Message & vbCrLf & "journal exiting", vbCritical + vbOKOnly)
Exit Sub
End Try
Next
If i = 0 Then
MsgBox("This part has no drawing sheets to export")
Else
MsgBox("Exported: " & i & " sheet(s) to pdf file" & vbCrLf & pdfFile, vbOKOnly + vbInformation)
End If
Dim myFlatPattern As Features.FlatPattern = Nothing
Dim c As Assemblies.ComponentAssembly = theSession.Parts.Display.ComponentAssembly
If IsNothing(c.RootComponent) Then
'Part has no components, look for flat pattern in this part
lw.WriteLine("part has no components, looking for flat pattern in this file")
myFlatPattern = GetFlatPattern(theSession.Parts.Display)
End If
Dim realComponents As New List(Of Assemblies.Component)
If c.RootComponent.GetChildren.Length > 1 Then
'this is an assembly, not a drawing file
'lw.WriteLine("part is not a drawing (it has more than one component), exiting")
'Exit Sub
'look for a single (non-drafting) component
For Each temp As Assemblies.Component In c.RootComponent.GetChildren
Dim isDraftComp As Boolean = False
theUfSession.Draw.IsDraftingComponent(temp.Tag, isDraftComp)
If Not isDraftComp Then
realComponents.Add(temp)
End If
Next
If realComponents.Count > 1 Then
lw.WriteLine("part is an assembly, exiting")
Exit Sub
End If
End If
'lw.WriteLine("display part has one component")
'lw.WriteLine("display part has " & c.RootComponent.GetChildren(0).GetChildren.Length.ToString & " grandchildren")
If c.RootComponent.GetChildren(0).GetChildren.Length <> 0 Then
'child component is a subassembly
Exit Sub
End If
If Not LoadComponent(realComponents.Item(0)) Then
'component not fully loaded, will not be able to access flat pattern feature info
lw.WriteLine("could not fully load component, exiting")
Exit Sub
End If
myFlatPattern = GetFlatPattern(realComponents.Item(0).Prototype.OwningPart)
If IsNothing(myFlatPattern) Then
'skip it
'warn user?
lw.WriteLine("flat pattern is nothing")
Else
'export flat pattern to dxf
lw.WriteLine("exporting dxf to: " & dxfFile)
ExportFlatPattern(myFlatPattern, dxfFile)
End If
lw.Close()
End Sub
Function GetFlatPattern(ByVal thePart As Part) As Features.FlatPattern
If IsNothing(thePart) Then
'part required
Return Nothing
End If
For Each myFeature As Features.Feature In thePart.Features
If TypeOf (myFeature) Is Features.FlatPattern Then
Return myFeature
End If
Next
'if we make it here, no flat pattern was found
Return Nothing
End Function
Sub ExportFlatPattern(ByVal theFlatPattern As Features.FlatPattern, ByVal outputFile As String)
Dim exportFlatPatternBuilder1 As NXOpen.Features.SheetMetal.ExportFlatPatternBuilder
exportFlatPatternBuilder1 = workPart.Features.SheetmetalManager.CreateExportFlatPatternBuilder()
exportFlatPatternBuilder1.AddedTop = True
exportFlatPatternBuilder1.AddedBottom = True
exportFlatPatternBuilder1.Type = Features.SheetMetal.ExportFlatPatternBuilder.FileType.Dxf
exportFlatPatternBuilder1.DxfRevision = NXOpen.Features.SheetMetal.ExportFlatPatternBuilder.DxfRevisionType.R14
exportFlatPatternBuilder1.OutputFile = outputFile
exportFlatPatternBuilder1.FlatPattern.Value = theFlatPattern
Dim nXObject1 As NXOpen.NXObject
nXObject1 = exportFlatPatternBuilder1.Commit()
exportFlatPatternBuilder1.Destroy()
End Sub
Function GetFileName()
Dim strPath As String
Dim strPart As String
Dim pos As Integer
'get the full file path
strPath = theSession.Parts.Display.FullPath
'get the part file name
pos = InStrRev(strPath, "\")
strPart = Mid(strPath, pos + 1)
strPath = Left(strPath, pos)
'strip off the ".prt" extension
strPart = Left(strPart, Len(strPart) - 4)
GetFileName = strPart
End Function
Function GetFilePath()
Dim strPath As String
Dim strPart As String
Dim pos As Integer
'get the full file path
strPath = theSession.Parts.Display.FullPath
'get the part file name
pos = InStrRev(strPath, "\")
strPart = Mid(strPath, pos + 1)
strPath = Left(strPath, pos)
'strip off the ".prt" extension
strPart = Left(strPart, Len(strPart) - 4)
GetFilePath = strPath
End Function
Sub ExportPDF(dwg As Drawings.DrawingSheet, outputFile As String, units As Integer)
Dim printPDFBuilder1 As PrintPDFBuilder
printPDFBuilder1 = workPart.PlotManager.CreatePrintPdfbuilder()
printPDFBuilder1.Scale = 1.0
printPDFBuilder1.Colors = PrintPDFBuilder.Color.BlackOnWhite
printPDFBuilder1.Size = PrintPDFBuilder.SizeOption.ScaleFactor
If units = 0 Then
printPDFBuilder1.Units = PrintPDFBuilder.UnitsOption.English
Else
printPDFBuilder1.Units = PrintPDFBuilder.UnitsOption.Metric
End If
printPDFBuilder1.XDimension = dwg.Height
printPDFBuilder1.YDimension = dwg.Length
printPDFBuilder1.OutputText = PrintPDFBuilder.OutputTextOption.Polylines
printPDFBuilder1.RasterImages = True
printPDFBuilder1.ImageResolution = PrintPDFBuilder.ImageResolutionOption.High
printPDFBuilder1.Append = True
printPDFBuilder1.Watermark = ""
Dim sheets1(0) As NXObject
Dim drawingSheet1 As Drawings.DrawingSheet = CType(dwg, Drawings.DrawingSheet)
sheets1(0) = drawingSheet1
printPDFBuilder1.SourceBuilder.SetSheets(sheets1)
printPDFBuilder1.Filename = outputFile
Dim nXObject1 As NXObject
nXObject1 = printPDFBuilder1.Commit()
printPDFBuilder1.Destroy()
End Sub
Private Function LoadComponent(ByVal theComponent As Assemblies.Component) As Boolean
Dim thePart As Part = theComponent.Prototype.OwningPart
Dim partName As String = ""
Dim refsetName As String = ""
Dim instanceName As String = ""
Dim origin(2) As Double
Dim csysMatrix(8) As Double
Dim transform(3, 3) As Double
Try
If thePart.IsFullyLoaded Then
'component is fully loaded
Else
'component is partially loaded
End If
Return True
Catch ex As NullReferenceException
'component is not loaded
Try
theUfSession.Assem.AskComponentData(theComponent.Tag, partName, refsetName, instanceName, origin, csysMatrix, transform)
Dim theLoadStatus As PartLoadStatus
theSession.Parts.Open(partName, theLoadStatus)
'_theUfSession.Assem.SetAssemOptions(curLoadOptions)
If theLoadStatus.NumberUnloadedParts > 0 Then
Dim allReadOnly As Boolean = True
For i As Integer = 0 To theLoadStatus.NumberUnloadedParts - 1
If theLoadStatus.GetStatus(i) = 641058 Then
'read-only warning, file loaded ok
Else
'641044: file not found
allReadOnly = False
End If
Next
If allReadOnly Then
Return True
Else
'warnings other than read-only...
Return False
End If
Else
Return True
End If
Catch ex2 As NXException
Return False
End Try
Catch ex As NXException
'unexpected error
Return False
Finally
End Try
End Function
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
