Code:
Option Strict Off
Imports System
Imports System.IO
Imports NXOpen
Imports NXOpen.Utilities
Imports NXOpen.UF
Imports NXOpen.Drawings
Imports System.Text
Module make_cgm_and_tif_of_all_drawing_sheets
Dim theSession As Session = Session.GetSession()
Dim ufs As UFSession = UFSession.GetUFSession()
Dim plot As UFPlot = ufs.Plot
Dim lw As ListingWindow = theSession.ListingWindow
Sub Echo(ByVal output As String)
theSession.ListingWindow.Open()
theSession.ListingWindow.WriteLine(output)
theSession.LogFile.WriteLine(output)
End Sub
Sub Main()
Dim iPosition As Integer
Dim StrNewpartName As String
Dim iSheetsNumber As Integer
Dim isheetsCount As Integer
'
' ----------------------------------------------- make sure we have a part
Dim this_part As NXOpen.Tag
Try
this_part = theSession.Parts.Work.Tag
Catch ex As Exception
If this_part = NXOpen.Tag.Null Then
MsgBox("You need an open part to run this program.", MsgBoxStyle.OkOnly)
Exit Sub ' no part, so exit program gracefully
End If
End Try
' -------------------------------------------------------------------------
Dim workPart As Part = theSession.Parts.Work
Dim workView As View = theSession.Parts.Work.Views.WorkView
Dim drawingSheets As DrawingSheet()
drawingSheets = workPart.DrawingSheets.ToArray
Dim mySheet As DrawingSheet
Dim JobName As String = Nothing
Dim tmp_dir As String = "J:\tif_zeichnungen\he"
Dim tmp_dir_2 As String = "J:\tif_zeichnungen\he"
Dim partName As String = workPart.Leaf.ToString
Dim sheetName As String
Dim ii As Integer
Dim cgmFileName As String
Dim tifFileName As String
Dim jobOptions As UFPlot.JobOptions
Dim bannerOptions As UFPlot.BannerOptions = Nothing
Dim iCounter As Integer
plot.AskDefaultJobOptions(jobOptions)
plot.AskDefaultBannerOptions(bannerOptions)
'ufs.UF.TranslateVariable("UGII_TMP_DIR", tmp_dir)
iSheetsNumber = 1
iCounter = 0
iSheetsCount = 0
For Each mySheet In drawingSheets '----------- Iterate through the sheets
iSheetsCount = iSheetsCount + 1 'Anzahl der Sheets ermitteln
Next
For Each mySheet In drawingSheets '----------- Iterate through the sheets
mySheet.Open()
' ------------------------------------------------------------ Update Views
'theSession.Parts.Work.DraftingViews.UpdateViews( _
'DraftingViewCollection.ViewUpdateOption.All, mySheet)
' ---------------------------------------------------------------- Plotting
sheetName = "Printing Sheet: " + mySheet.Name
cgmFileName = tmp_dir + "\" + partName + "_" + mySheet.Name + ".cgm"
ufs.Ui.SetPrompt("Waiting for CGM file: " & cgmFileName)
plot.SaveCgm(mySheet.Tag, jobOptions, JobName, bannerOptions, cgmFileName)
' does the file exist?
Dim status As Integer = -1
Do
ufs.Cfi.AskFileExist(cgmFileName, status)
Loop Until status = 0
' the CGM is there, so do the conversion
tifFileName = tmp_dir_2 + "\" + partName + "_" + mySheet.Name + ".tif"
ufs.Ui.SetPrompt("Creating TIFF File..." & tifFileName)
' this is easy but will always use 72 dpi resolution:
' plot.ConvertFile(cgmFileName, UFPlot.Format.TiffFormat, tifFileName)
' So to use a different resolution do this instead:
Dim baseDir As String = Nothing
ufs.UF.TranslateVariable("UGII_BASE_DIR", baseDir)
Dim exPath As String = String.Concat(baseDir, "\NXPLOT\cgm2tiff.exe")
Dim proc As New Diagnostics.Process
proc.StartInfo.FileName = exPath
proc.StartInfo.Arguments = " " & cgmFileName & " " & tifFileName & " -resolution=400 -mono"
proc.StartInfo.WindowStyle = Diagnostics.ProcessWindowStyle.Hidden
proc.Start()
'Do
'ufs.Cfi.AskFileExist(tifFileName, status)
system.threading.thread.sleep(2000)
If File.Exists(tmp_dir_2 + "\" + partName + "_" + mySheet.Name + ".tif") Then
iPosition = InStr(partName, "_dwg") 'gibt die Stelle zurück, an der "_dwg" in partname beginnt
If iPosition <> 0 Then 'wenn iPosition = 0 dann kein _dwg im String
StrNewpartName = Mid(partname, 1, iPosition - 1) 'Mid gibt Teilstring aus partname ab Stelle 1 und der Länge iPosition -1 zurück
End If
If iSheetsCount = 1 Then
If File.Exists(tmp_dir_2 + "\" + StrNewpartName + "_" + CStr(iSheetsNumber) + ".tif") Then
My.Computer.FileSystem.DeleteFile(tmp_dir_2 + "\" + StrNewpartName + ".tif")
End If
My.Computer.FileSystem.RenameFile(tmp_dir_2 + "\" + partName + "_" + mySheet.Name + ".tif", StrNewpartName + ".tif")
Else
If File.Exists(tmp_dir_2 + "\" + StrNewpartName + "_" + CStr(iSheetsNumber) + ".tif") Then
My.Computer.FileSystem.DeleteFile(tmp_dir_2 + "\" + StrNewpartName + "_" + CStr(iSheetsNumber) + ".tif")
End If
My.Computer.FileSystem.RenameFile(tmp_dir_2 + "\" + partName + "_" + mySheet.Name + ".tif", StrNewpartName _
+ "_" + CStr(iSheetsNumber) + ".tif")
iSheetsNumber = iSheetsNumber + 1
End If
My.Computer.FileSystem.DeleteFile(tmp_dir + "\" + partName + "_" + mySheet.Name + ".cgm")
End If
Next '------------------------------------------ End of the FOR-NEXT loop
ufs.Ui.SetPrompt("Finished")
End Sub
Public Function GetUnloadOption(ByVal dummy As String) As Integer
GetUnloadOption = UFConstants.UF_UNLOAD_IMMEDIATELY
End Function
End Module