Hi,
When i try to run the below code (Stamped PDF for QC), If I have one sheet Dwg it is adding empty second sheet while creating the table, If it is multi sheet Dwg I am not getting any issues. Please let me know where is the problem, So that I could correct it.
Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.UF
Imports System.Windows.Forms
Imports NXOpen.Annotations
Imports NXOpen.Utilities
Imports System.Collections.Generic
Imports NXOpen.UF.UFDraw
Imports NXOpen.Drawings
Imports System.Windows.Forms.MessageBox
Imports System.IO
Imports System.Collections
' NX Echeck Stamp
' Journal created by Alto on 10-06-2015
Module NXJournal
Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim ufs As UFSession = UFSession.GetUFSession()
Dim ui As UI = ui.GetUI()
Dim fontIndex1 As Integer
Sub Main()
' Create the tabular note
Dim taborgin As Point3d = New Point3d(9.72414748499, 2.55025773063, 0)
Dim newcolumns As Integer = 3
Dim newrows As Integer = 5
Dim tabnote As NXOpen.Tag = CreateTabnoteWithSize(newrows, newcolumns, taborgin)
' Get the column tags
Dim columns(newcolumns - 1) As NXOpen.Tag
Dim rows(newrows) As NXOpen.Tag
Dim i As Integer
Dim j As Integer
Dim height As Double = Nothing
Dim width As Double = Nothing
For i = 0 To newcolumns - 1
ufs.Tabnot.AskNthColumn(tabnote, i, columns(i))
ufs.Tabnot.AskColumnWidth(columns(i), width)
width = 0.7
ufs.Tabnot.SetColumnWidth(columns(i), width)
Next
For j = 0 To newrows - 1
ufs.Tabnot.AskNthRow(tabnote, j, rows(j))
ufs.Tabnot.AskRowHeight(rows(j), height)
height = 0.22
ufs.Tabnot.SetRowHeight(rows(j), height)
Next
Dim pt1 As Point = Nothing
Dim cell1 As NXOpen.Tag
Dim cellprefes As UFTabnot.CellPrefs = Nothing
ufs.Tabnot.AskCellAtRowCol(rows(0), columns(0), cell1)
Dim cell2 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(rows(0), columns(2), cell2)
ufs.Tabnot.MergeCells(cell1, cell2)
Dim cell3 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(rows(4), columns(0), cell3)
Dim cell4 As NXOpen.Tag
ufs.Tabnot.AskCellAtRowCol(rows(4), columns(2), cell4)
ufs.Tabnot.MergeCells(cell3, cell4)
ufs.Tabnot.AskCellAtRowCol(rows(0), columns(0), cell1)
ufs.Tabnot.SetCellText(cell1, "IN REVIEW PROCESS CHECK")
ufs.Tabnot.AskCellAtRowCol(rows(1), columns(0), cell1)
ufs.Tabnot.SetCellText(cell1, "E CHECK")
ufs.Tabnot.AskCellAtRowCol(rows(1), columns(1), cell1)
ufs.Tabnot.SetCellText(cell1, "NOG")
ufs.Tabnot.AskCellAtRowCol(rows(1), columns(2), cell1)
ufs.Tabnot.SetCellText(cell1, "CM")
ufs.Tabnot.AskCellAtRowCol(rows(2), columns(0), cell1)
ufs.Tabnot.SetCellText(cell1, "CHECK")
ufs.Tabnot.AskCellAtRowCol(rows(2), columns(1), cell1)
ufs.Tabnot.SetCellText(cell1, "CERT")
ufs.Tabnot.AskCellAtRowCol(rows(2), columns(2), cell1)
ufs.Tabnot.SetCellText(cell1, "ENG APVD")
ufs.Tabnot.AskCellAtRowCol(rows(3), columns(0), cell1)
ufs.Tabnot.SetCellText(cell1, "METHODS")
ufs.Tabnot.AskCellAtRowCol(rows(3), columns(1), cell1)
ufs.Tabnot.SetCellText(cell1, "FLAM")
ufs.Tabnot.AskCellAtRowCol(rows(3), columns(2), cell1)
ufs.Tabnot.SetCellText(cell1, "DESIGN ENG")
ufs.Tabnot.AskCellAtRowCol(rows(4), columns(0), cell1)
ufs.Tabnot.SetCellText(cell1, "(IN ACCORDANCE WITH ALL APPLICABLE PROCESSES AND PROCEDURES)")
ufs.Tabnot.AskCellAtRowCol(rows(4), columns(0), cell4)
ufs.Tabnot.AskCellPrefs(cell4, cellprefes)
cellprefes.fit_methods(0) = UFTabnot.FitMethod.FitMethodWrap
ufs.Tabnot.SetCellPrefs(cell4, cellprefes)
ufs.Tabnot.AskCellAtRowCol(rows(0), columns(0), cell4)
ufs.Tabnot.AskCellPrefs(cell4, cellprefes)
cellprefes.fit_methods(0) = UFTabnot.FitMethod.FitMethodAutoSizeText
ufs.Tabnot.SetCellPrefs(cell4, cellprefes)
For i = 0 To newrows - 1
For j = 0 To newcolumns - 1
ufs.Tabnot.AskCellAtRowCol(rows(i), columns(j), cell1)
ufs.Tabnot.AskCellPrefs(cell1, cellprefes)
fontIndex1 = workPart.Fonts.AddFont("ideas_iso")
cellprefes.format = UFTabnot.Format.FormatText
cellprefes.text_font = fontIndex1
cellprefes.text_height = 0.05
cellprefes.text_aspect_ratio = 1.0 '
cellprefes.text_angle = 0.0
cellprefes.text_slant = 0.0
cellprefes.line_space_factor = 1.0
cellprefes.char_space_factor = 1.0
cellprefes.text_color = 6
cellprefes.horiz_just = UFTabnot.Just.JustLeft
cellprefes.vert_just = UFTabnot.Just.JustTop
ufs.Tabnot.SetCellPrefs(cell1, cellprefes)
Next
Next
For i = 0 To newcolumns - 1
ufs.Tabnot.AskNthColumn(tabnote, i, columns(i))
ufs.Tabnot.AskColumnWidth(columns(i), width)
width = 0.75
ufs.Tabnot.SetColumnWidth(columns(i), width)
Next
For j = 0 To newrows - 1
ufs.Tabnot.AskNthRow(tabnote, j, rows(j))
ufs.Tabnot.AskRowHeight(rows(j), height)
height = 0.23238
ufs.Tabnot.SetRowHeight(rows(j), height)
Next
ufs.Tabnot.AskRowHeight(rows(0), height)
height = 0.1
ufs.Tabnot.SetRowHeight(rows(0), height)
ufs.Tabnot.AskRowHeight(rows(4), height)
height = 0.2
ufs.Tabnot.SetRowHeight(rows(4), height)
Dim letteringPrefs As LetteringPreferences = Nothing
Dim userSymPrefs As UserSymbolPreferences = Nothing
Call Printpdf()
Dim notifyOnDelete1 As Boolean
notifyOnDelete1 = theSession.Preferences.Modeling.NotifyOnDelete
theSession.UpdateManager.ClearErrorList()
Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Delete")
Dim objects1(0) As NXObject
Dim displayableObject1 As DisplayableObject = CType(workPart.FindObject("ENTITY 165 9 1"), DisplayableObject)
objects1(0) = displayableObject1
Dim nErrs1 As Integer
nErrs1 = theSession.UpdateManager.AddToDeleteList(objects1)
Dim notifyOnDelete2 As Boolean
notifyOnDelete2 = theSession.Preferences.Modeling.NotifyOnDelete
Dim nErrs2 As Integer
nErrs2 = theSession.UpdateManager.DoUpdate(markId1)
End Sub
Sub Printpdf()
Dim dwgs As Drawings.DrawingSheetCollection
dwgs = workPart.DrawingSheets
Dim sheet As Drawings.DrawingSheet
Dim i As Integer
Dim pdfFile As String = Nothing
Dim currentPath As String = Nothing
Dim currentFile As String = Nothing
Dim exportFile As String = Nothing
Dim partUnits As Integer = Nothing
Dim strOutputFolder As String = Nothing
Dim strRevision As String = Nothing
Dim rspFileExists
Dim rspAdvancePrint = Nothing
Dim IsTcEng As Boolean = False
Dim UFSes As UFSession = UFSession.GetUFSession()
UFSes.UF.IsUgmanagerActive(IsTcEng)
partUnits = displayPart.PartUnits
'Read TCE attributes
If IsTcEng Then
currentFile = workPart.GetStringAttribute("DB_PART_NO")
strRevision = workPart.GetStringAttribute("DB_PART_REV")
End If
exportFile = currentFile
strOutputFolder = OutputPath()
'if we don't have a valid directory (ie the user pressed 'cancel') exit the journal
If Not Directory.Exists(strOutputFolder) Then
Exit Sub
End If
strOutputFolder = strOutputFolder & "\"
Dim shts As New ArrayList()
For Each sheet In dwgs
shts.Add(sheet.Name)
Next
shts.Sort()
i = 0
Dim sht As String
For Each sht In shts
For Each sheet In dwgs
If sheet.Name = sht Then
i = i + 1
If strRevision <> "" Then
pdfFile = strOutputFolder & exportFile & "_" & strRevision & ".pdf"
Else
pdfFile = strOutputFolder & exportFile & ".pdf"
End If
If i = 1 Then
If File.Exists(pdfFile) Then
rspFileExists = MsgBox("The file: '" & pdfFile & "' Already exists; overwrite?", vbYesNo + vbQuestion)
If rspFileExists = vbYes Then
Try
File.Delete(pdfFile)
Catch ex As Exception
MsgBox(ex.Message & vbCrLf & "Journal exiting", vbCritical + vbOKOnly, "Error")
Exit Sub
End Try
Else
Exit Sub
End If
End If
End If
'update any views that are out of date
theSession.Parts.Work.DraftingViews.UpdateViews(Drawings.DraftingViewCollection.ViewUpdateOption.OutOfDate, sheet)
Try
ExportPDF(sheet, pdfFile, partUnits, rspAdvancePrint)
Catch ex As Exception
MsgBox("Error occurred in PDF export" & vbCrLf & ex.Message & vbCrLf & "journal exiting", vbCritical + vbOKOnly, "Error")
Exit Sub
End Try
Exit For
End If
Next
Next
If i = 0 Then
MessageBox.Show("This part has no drawing sheets to export", "PDF export failure", MessageBoxButtons.OK, MessageBoxIcon.Warning)
Else
MessageBox.Show("Exported: " & i & " sheet(s) to pdf file" & vbCrLf & pdfFile, "PDF export success", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
End Sub
Function OutputPath()
Dim strLastPath As String = Nothing
Try
strLastPath = GetSetting("NX journal", "Export pdf", "ExportPath")
Catch e As ArgumentException
Catch e As Exception
MsgBox(e.GetType.ToString)
Finally
End Try
Dim FolderBrowserDialog1 As New FolderBrowserDialog
With FolderBrowserDialog1
.RootFolder = Environment.SpecialFolder.Desktop
If Directory.Exists(strLastPath) Then
.SelectedPath = strLastPath
Else
.SelectedPath = "H:\"
End If
.Description = "Select the directory to export .pdf file"
If .ShowDialog = DialogResult.OK Then
OutputPath = .SelectedPath
SaveSetting("NX journal", "Export pdf", "ExportPath", .SelectedPath)
Else
OutputPath = 0
End If
End With
End Function
Sub ExportPDF(dwg As Drawings.DrawingSheet, outputFile As String, units As Integer, advancePrint As Integer)
Dim printPDFBuilder1 As PrintPDFBuilder
printPDFBuilder1 = workPart.PlotManager.CreatePrintPdfbuilder()
printPDFBuilder1.Scale = 1.0
printPDFBuilder1.Action = PrintPDFBuilder.ActionOption.Native
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.Medium
printPDFBuilder1.Append = True
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
Public Function CreateTabnoteWithSize( _
ByVal nRows As Integer, ByVal nColumns As Integer, ByVal loc As Point3d) As NXOpen.Tag
Dim secPrefs As UFTabnot.SectionPrefs = Nothing
ufs.Tabnot.AskDefaultSectionPrefs(secPrefs)
Dim cellPrefs As UFTabnot.CellPrefs = Nothing
Dim origin(2) As Double
origin(0) = loc.X
origin(1) = loc.Y
origin(2) = loc.Z
Dim tabnote As NXOpen.Tag
ufs.Tabnot.Create(secPrefs, origin, tabnote)
Dim nmRows As Integer = 0
ufs.Tabnot.AskNmRows(tabnote, nmRows)
For ii As Integer = 0 To nmRows - 1
Dim row As NXOpen.Tag
ufs.Tabnot.AskNthRow(tabnote, 0, row)
ufs.Tabnot.RemoveRow(row)
ufs.Obj.DeleteObject(row)
Next
Dim nmColumns As Integer = 0
ufs.Tabnot.AskNmColumns(tabnote, nmColumns)
For ii As Integer = 0 To nmColumns - 1
Dim column As NXOpen.Tag
ufs.Tabnot.AskNthColumn(tabnote, 0, column)
ufs.Tabnot.RemoveColumn(column)
ufs.Obj.DeleteObject(column)
Next
Dim columns(nColumns - 1) As NXOpen.Tag
For ii As Integer = 0 To nColumns - 1
If ii = 0 Then
ufs.Tabnot.CreateColumn(20, columns(ii))
Else
ufs.Tabnot.CreateColumn(40, columns(ii))
End If
ufs.Tabnot.AddColumn(tabnote, columns(ii), UFConstants.UF_TABNOT_APPEND)
Next
Dim rows(nRows - 1) As NXOpen.Tag
For ii As Integer = 0 To nRows - 1
ufs.Tabnot.CreateRow(10, rows(ii))
ufs.Tabnot.AddRow(tabnote, rows(ii), UFConstants.UF_TABNOT_APPEND)
Next
Return tabnote
End Function
Public Function GetUnloadOption(ByVal dummy As String) As Integer
Return Session.LibraryUnloadOption.Immediately
End Function
End Module
re: new sheet
What version of NX are you using and are you using Teamcenter?
I created a single sheet drawing in NX 9.0.3.4 (native) and ran your code. I did not notice a second drawing sheet being used during or after execution of the journal.
NX version
I am using NX 7.5 along with Teamcenter 9.1
Regards,
Joe
re: extra drawing sheet
I've tested your code in NX 7.5, 8, 8.5, and 9; the extra sheet is only created in NX 7.5. I don't see any commands in your code that would create a new sheet. Since this behavior is only in NX 7.5, I would assume that it was a bug that was fixed in later versions. You may want to contact GTAC to confirm this and/or see if they have a recommended work-around.
One alternative that I can think of would be to save a list (or array) of current drawing sheets at the start of your journal; before the pdf export, delete any sheets in the part that are not in the saved list. Be careful if you implement this idea; I would suggest checking that the sheet has no objects on it before deleting it!
Thanks
Thank you very much for the testing. Anyhow my company is going upgrade to NX9 in next two months, I think I good wait a bit.
Regards,
Joe
Updated with If condition
I added a condition to sort this out to either keep or delete the second sheet.
Sub Main()
Dim dwgs As Drawings.DrawingSheetCollection
dwgs = workPart.DrawingSheets
Dim sheet As Drawings.DrawingSheet
Dim shts As New ArrayList()
For Each sheet In dwgs
shts.Add(sheet.Name)
Next
If shts.Count > 1 Then
Call Stamponmultiplesheet()
ElseIf shts.Count = 1 Then
Call Stamponsinglesheet()
End If
End Sub
Regards,
Joe