Option Explicit On Imports pfcls Imports System.IO Imports Ookii Imports iTextSharp.text.pdf Imports Excel = Microsoft.Office.Interop.Excel Imports System.Runtime.InteropServices Imports Newtonsoft.Json Imports Newtonsoft.Json.Linq Imports System.Net Imports System.Text Imports System.Runtime.Serialization.Formatters.Binary Imports System.Runtime.Serialization Imports Microsoft.Win32 Imports System.ComponentModel Imports System.Windows.Interop Public Class MainWindow Dim NewWindow As New Form2 Public Shared ParamValueD As String = "" Public Shared ParamNameD As String = "" Public Shared HibakSzama As Integer = 0 Public str1 As String Public str2 As String Public Shared sresult As String Public Shared ddas As Boolean = True Dim FilesList As New List(Of String) Dim drw_names As New List(Of String) Dim drw_paths As New List(Of String) Dim FileNames As New List(Of String) Dim row_count As Single Dim strFilePath As String Dim table As IpfcTable = Nothing Dim i As Single Dim pdfFiles As New List(Of String) Dim PathToPurge As String Dim NameList As New List(Of String) Dim models As New List(Of IpfcModel) 'table Dim SHMNum As String Dim NameT As String Dim MachineName As String Dim SHMDate As String Dim SubMachineName As String Dim AudiNum As String Dim excelPrintNeeded As Boolean Dim NeedPdf As Boolean = True Dim NeedPdfOssze As Boolean Dim NeedDxf As Boolean Dim NeedDWG As Boolean Dim NeedTiff As Boolean Dim NeedParams As Boolean Dim NeedXls As Boolean Dim NeedStroke As Boolean Dim NeedSheetNumbers As Boolean Dim xlApp As Excel.Application Dim xlWorkBook As Excel.Workbook Dim xlWorkSheet As Excel.Worksheet Dim ProgressTextstr As String Dim LoadingPoints As String Dim LoadingPointsCount As Integer = 0 Dim FileNameModTimer As String Dim q As Integer = 0 'FilesCreated Dim xlsCreated As New List(Of String) Dim dxfCreated As New List(Of String) Dim tiffCreated As New List(Of String) Dim DWGCreated As New List(Of String) Dim pdfCreated As New List(Of String) Dim params As New List(Of String) Public Shared workDir As String Dim SheetNumber As Integer Dim SheetPartList As New List(Of String) Dim folderpicked As String Dim WithEvents BackgroundWorker1 As New BackgroundWorker() Dim WithEvents BackgroundWorker2 As New BackgroundWorker() Dim WithEvents BackgroundWorker3 As New BackgroundWorker() Public Shared dict As New Dictionary(Of String, String)(System.StringComparer.Ordinal) Dim isSeperateDrawing As Boolean Dim isEllNeeded As Boolean Dim sheetParamNeeded As Boolean Dim printNeeded As Boolean Dim autofolder As Boolean Dim namingsyntax As String Dim xlstype As String = "" Dim session As IpfcBaseSession = Nothing Dim conn As IpfcAsyncConnection = Nothing 'Buttons Private Sub MyWindow_Loaded(ByVal sender As Object, ByVal e As EventArgs) Handles MainWindow.Loaded BackgroundWorker2.WorkerReportsProgress = True BackgroundWorker2.WorkerSupportsCancellation = True BackgroundWorker1.WorkerReportsProgress = True For Each param As String In Environment.GetCommandLineArgs params.Add(param) ' MsgBox(param) Next param PDFCheckBox.IsChecked = True DXFCheckBox.IsChecked = True DWGCheckBox.IsChecked = True XLSCheckbox.IsChecked = True NamingSyntaxStefani.IsChecked = True namingsyntax = "stefani" If params.Contains("-arg") Then Try For Each P As Process In System.Diagnostics.Process.GetProcessesByName("cmd") P.Kill() Next Catch ex As Exception End Try Me.Opacity = 0 PDFCheckBox.IsChecked = False DXFCheckBox.IsChecked = False DWGCheckBox.IsChecked = False XLSCheckbox.IsChecked = False If params.Contains("-pdf") Then PDFCheckBox.IsChecked = True End If If params.Contains("-dxf") Then DXFCheckBox.IsChecked = True End If If params.Contains("-DWG") Then DWGCheckBox.IsChecked = True End If If params.Contains("-xls") Then XLSCheckbox.IsChecked = True End If If params.Contains("-tiff") Then TIFFCheckbox.IsChecked = True End If If params.Contains("-auto_folder") Then AutomaticFolderSelect.IsChecked = True End If If params.Contains("-audi") Then NamingSyntaxAudi.IsChecked = True NamingSyntaxStefani.IsChecked = False End If If params.Contains("-hanondoksi") Then PDFCheckBox.IsChecked = True DXFCheckBox.IsChecked = True DWGCheckBox.IsChecked = True XLSCheckbox.IsChecked = True NamingSyntaxStefani.IsChecked = False End If If params.Contains("-ell") Then isEllNeeded = True End If CreateDocument.RaiseEvent(New RoutedEventArgs(Button.ClickEvent)) End If Try Process.GetProcessesByName("pfclscom")(0).Kill() Catch ex As Exception End Try Try Connect(session, conn) Catch ex As Exception If ex.Message = "pfcExceptions::XToolkitAmbiguous" Then MsgBox("Egynél több Creo fut, kérlezk zárd be az egyiket.") End If Exit Sub End Try workDir = session.GetCurrentDirectory ' MsgBox(workDir) End Sub Private Sub Destenation_Browse_Click(sender As Object, e As EventArgs) 'Jelenleg nem használt!!! Dim mydig As New Dialogs.Wpf.VistaFolderBrowserDialog mydig.SelectedPath = folderpicked mydig.ShowDialog() If Not Strings.Right(mydig.SelectedPath, 1) = "\" Then folderpicked = mydig.SelectedPath() + "\" End If End Sub Private Sub Files_Browse_Click(sender As Object, e As EventArgs) Handles Files_Browse.Click 'Dialogbox megmutatása ListBox1.Items.Clear() FilesList.Clear() Dim b As New OpenFileDialog b.Multiselect = True 'Több file kijelölhetősége b.Filter = "DRW|*drw.1|All version drw|*.drw*" 'Alap formátum kiválasztáas b.InitialDirectory = workDir ' MsgBox(workDir) ' b.AutoUpgradedimEnabled = True 'ez biztos rossz lesz!!!!!!!!!!!! ' Dim bul As Boolean ' bul = b.ShowDialog Purge.Purge(workDir, 999, ".drw", False, False, Path.GetTempPath() + "temp.txt") If b.ShowDialog() = True Then Dim names As String() = b.FileNames For Each name As String In names ListBox1.Items.Add(Path.GetFileNameWithoutExtension(name)) FilesList.Add(name) Next End If End Sub Private Sub CreateDocument_Click(sender As Object, e As RoutedEventArgs) Handles CreateDocument.Click ' MsgBox(workDir) If PDFCheckBox.IsChecked = True Or DXFCheckBox.IsChecked = True Or DWGCheckBox.IsChecked = True Or TIFFCheckbox.IsChecked = True Or XLSCheckbox.IsChecked = True Then ' MsgBox(session.ConnectionId) If autofolder = True Then Dim FileExtPos As Integer workDir = Path.GetDirectoryName(workDir) Try FileExtPos = Path.GetFullPath(workDir).LastIndexOf("02 - Modellek") workDir = workDir.Substring(0, FileExtPos) Catch ex As Exception End Try 'workDir = Path.GetDirectoryName(workDir) ' workDir = Path.GetDirectoryName(workDir) Dim model1 As IpfcModel = Nothing model1 = session.CurrentModel ' Dim tempstr As String = "" ' ReadParam(model1, "OA_MEGNEVEZES_2", tempstr) ' MsgBox(namingsyntax) If namingsyntax = "stefani" Then ' Dim tempstr As String = "" ' ReadParam(model1, "OA_MEGNEVEZES_2", tempstr) Dim temp_model As IpfcModel temp_model = session.CurrentModel Dim OA_MEGNEVEZES_2 As String = "" ReadParam(temp_model, "OA_MEGNEVEZES_2", OA_MEGNEVEZES_2) workDir = workDir + "\03 - Gyártási dokumentáció\" + model1.FullName + " - " + OA_MEGNEVEZES_2 + "\" Else Dim tempstr As String = "" ReadParam(model1, "AUDI_RAJZSZAM", tempstr) tempstr = tempstr.Substring(0, 3) + "000-" + tempstr.Substring(3, 3) + "-" + tempstr.Substring(7, 6) + "-001" workDir = workDir + "04 - Leadási dokumentáció\INV-____\Zeichnungsdokumentation_2D-Daten\" + tempstr + "\" End If System.IO.Directory.CreateDirectory(workDir) End If ' MsgBox(workDir) conn.Disconnect(1) If autofolder = False Then Dim mydig As New Dialogs.Wpf.VistaFolderBrowserDialog mydig.SelectedPath = workDir mydig.ShowDialog() If Not Strings.Right(mydig.SelectedPath, 1) = "\" Then folderpicked = mydig.SelectedPath() + "\" End If Else folderpicked = "aaas" End If Else folderpicked = "casddasdasdawindows" End If 'Figyelmeztetés hogy túl hosszú az elérési út '--- '' Dim asn As DialogResult ' asn = MessageBox.Show(, ' "Hajjaj..", '' MessageBoxButtons.YesNo, ' MessageBoxIcon.Warning, ' MessageBoxDefaultButton.Button1) ' End If ' If asn = DialogResult.No Then If NamingSyntaxStefani.IsChecked Then namingsyntax = "stefani" xlstype = "" ElseIf NamingSyntaxAudi.IsChecked Then namingsyntax = "audi" xlstype = "" End If '\-- If folderpicked.Length > 196 Then Dim result As MessageBoxResult = MessageBox.Show("A kiválasztotte elérésiút túl hosszű, szeretnéd folytatni?", "Hajjaj..", MessageBoxButton.YesNo, MessageBoxImage.Warning) If result = MessageBoxResult.Yes Then Exit Sub End If End If If folderpicked.Length > 1 Then ' Dim ctrl As Control ' MainWindomForm.IsEnabled = False ' For Each ctrl In ' Console.WriteLine(ctrl.Name) ' If Not ctrl.Name = "MaterialLabel9" Then ' ctrl.Enabled = False 'End If ' Next MainGrid.IsEnabled = False BackgroundWorker2.RunWorkerAsync() BackgroundWorker1.RunWorkerAsync() End If ' Close() End Sub Private Sub AutomateFolderPick_Cick(sender As Object, e As EventArgs) Dim session As IpfcBaseSession = Nothing Dim conn As IpfcAsyncConnection = Nothing Connect(session, conn) AutomatedFolderPick(session) conn.Disconnect(1) End Sub 'Radio Buttons Private Sub MaterialRadioButton4_CheckedChanged(sender As Object, e As EventArgs) ListBox1.IsEnabled = True Files_Browse.IsEnabled = True PDFOsszeCheckBox.IsEnabled = True End Sub Private Sub MaterialRadioButton3_CheckedChanged(sender As Object, e As EventArgs) ListBox1.IsEnabled = False Files_Browse.IsEnabled = False PDFOsszeCheckBox.IsEnabled = False PDFOsszeCheckBox.IsChecked = False 'XLSCheckBox.Enabled = True ' XLSCheckBox.Checked = True ListBox1.Items.Clear() FilesList.Clear() End Sub 'Check boxes Private Sub DxfCheckBox_CheckedChanged(sender As Object, e As EventArgs) Handles DXFCheckBox.Checked, DXFCheckBox.Unchecked If DXFCheckBox.IsChecked = True Then NeedDxf = True Else NeedDxf = False End If End Sub Private Sub DWGCheckBox_CheckedChanged(sender As Object, e As EventArgs) Handles DWGCheckBox.Checked, DWGCheckBox.Unchecked If DWGCheckBox.IsChecked = True Then NeedDWG = True Else NeedDWG = False End If End Sub Private Sub XLSCheckBox_CheckedChanged(sender As Object, e As EventArgs) Handles XLSCheckbox.Checked, XLSCheckbox.Unchecked If XLSCheckbox.IsChecked = True Then NeedXls = True Else NeedXls = False End If End Sub Private Sub TiffCheckBox_CheckedChanged(sender As Object, e As EventArgs) Handles TIFFCheckbox.Checked, TIFFCheckbox.Unchecked If TIFFCheckbox.IsChecked = True Then NeedTiff = True Else NeedTiff = False End If End Sub Private Sub PDFOsszeCheckBox_CheckedChanged(sender As Object, e As EventArgs) Handles PDFCheckBox.Checked, PDFCheckBox.Unchecked If PDFOsszeCheckBox.IsChecked = True Then NeedPdfOssze = True Else NeedPdfOssze = False End If End Sub Private Sub PdfCheckBox_CheckedChanged(sender As Object, e As EventArgs) Handles PDFCheckBox.Checked, PDFCheckBox.Unchecked If PDFCheckBox.IsChecked = True Then NeedPdf = True Else NeedPdf = False End If If KulonAloRajzok.IsChecked = True Then If PDFCheckBox.IsChecked = True Then PDFOsszeCheckBox.IsEnabled = True PDFOsszeCheckBox.IsChecked = True Else PDFOsszeCheckBox.IsEnabled = False PDFOsszeCheckBox.IsChecked = False End If End If End Sub 'Document creation subs Private Sub CreateDocuments() xlsCreated.Clear() dxfCreated.Clear() tiffCreated.Clear() DWGCreated.Clear() pdfCreated.Clear() HibakSzama = 0 If isSeperateDrawing = True Then ' Dim filenames As New List(Of String) Dim FileExtPos As Single Dim FileExtPos_names As Single For Each item As String In FilesList FileExtPos = Path.GetFullPath(item).LastIndexOf("\") FileExtPos_names = Path.GetFileNameWithoutExtension(item).LastIndexOf(".") drw_names.Add(Path.GetFileNameWithoutExtension(item).Substring(0, FileExtPos_names)) drw_paths.Add(Path.GetFullPath(item).Substring(0, FileExtPos + 1)) FileNames.Add(Path.GetFileNameWithoutExtension(item)) Next row_count = drw_paths.Count End If Dim session As IpfcBaseSession = Nothing Dim conn As IpfcAsyncConnection = Nothing Dim y As Single SheetNumber = 1 ProgressTextstr = "Csatlakozás..." BackgroundWorker1.ReportProgress(0) Connect(session, conn) ' Threading.Thread.Sleep(2500) Dim model1 As IpfcModel = session.CurrentModel ' HandlePage(session, y) If namingsyntax = "stefani" Then HideShowTables(session, model1, 0) End If conn.Disconnect(1) q = 0 i = 0 ' table.Display() NameList.Clear() drw_names.Clear() drw_paths.Clear() FileNames.Clear() pdfFiles.Clear() folderpicked = "" End Sub Private Sub HandlePage(session As IpfcBaseSession, y As Single) Dim model1 As IpfcModel = Nothing Dim options As IpfcRetrieveModelOptions = Nothing Dim oModelDescriptor As IpfcModelDescriptor = Nothing Dim oModelDescriptorCreate As New CCpfcModelDescriptor Dim sheetowner As IpfcSheetOwner = Nothing Dim Drawing As IpfcDrawing = Nothing Dim oWindow As IpfcWindow If isSeperateDrawing = False Then row_count = 1 drw_names.Add(session.CurrentModel.FileName) FileNames.Add(session.CurrentModel.FileName) End If For y = 0 To row_count - 1 oModelDescriptor = oModelDescriptorCreate.Create(EpfcModelType.EpfcMDL_DRAWING, drw_names(y), "") If isSeperateDrawing = True Then options = (New CCpfcRetrieveModelOptions).Create options.AskUserAboutReps = False oModelDescriptor.Path = drw_paths(y) Console.WriteLine("Cél könyvtár:" + drw_paths(y)) Console.WriteLine("File Name:" + drw_names(y)) Try model1 = session.RetrieveModelWithOpts(oModelDescriptor, options) Catch ex As Exception MsgBox("Nem lehet megnyitni a rajzot! (Nincs a modell a mappában?)") End Try Else Try model1 = session.CurrentModel Catch ex As Exception MsgBox("Active window not drw? " & ex.Message) Exit Sub End Try End If If isSeperateDrawing = True Then oWindow = session.OpenFile(oModelDescriptor) oWindow.Activate() Else oWindow = session.CurrentWindow oWindow.Activate() End If ' Dim iTableOwner As IpfcTableOwner iTableOwner = model1 iTableOwner.UpdateTables() 'Count Number of sheets Dim LapokSzama As Integer sheetowner = model1 LapokSzama = sheetowner.NumberOfSheets Drawing = CType(model1, IpfcDrawing) 'Write parameters if needed ' If NeedParams = True Then 'WriteParam(model1, FocsoportTextLine.Text, "oa_megnevezes_1") 'WriteParam(model1, AlcsoportTextLine.Text, "oa_megnevezes_2") ' WriteParam(model1, AudiRajzszamParam.Text, "AUDI_RAJZSZAM") ' End If 'Handles sheets on drw ' ChangeSheets(model1, session, Drawing) HandleSheet(session, sheetowner, model1, Drawing, LapokSzama, y) 'Create PDF if needed If NeedPdf = True Then Dim FileNameMod As String ' MsgBox(FileNames(y)) FileNameMod = FileNames(y) HandleNames(FileNameMod, y, 0, ".PDF", model1) CreatePdf(session, model1, FileNameMod) End If Dim iWindows As IpfcWindows iWindows = session.ListWindows ' MsgBox(WindowCount) 'Close active window If isSeperateDrawing = True Then oWindow.Close() End If Next 'Merge PDF if needed If NeedPdfOssze = True Then MergePdfFiles(pdfFiles, folderpicked + "/Oszefuzott.pdf") End If End Sub Private Sub HandleSheet(Session As IpfcBaseSession, SheetOwner As IpfcSheetOwner, Model1 As IpfcModel, Drawing As IpfcDrawing, LapokSzama As Single, y As Single) Dim FileNameMod As String Drawing.CurrentSheetnumber = 1 FileNameMod = FileNames(y) If NeedXls = True Then If isSeperateDrawing = True Then If y = 0 Then HandleNames(FileNameMod, y, i, ".xls", Model1) CreateExcel(Session, FileNameMod) End If Else HandleNames(FileNameMod, y, i, ".xls", Model1) CreateExcel(Session, FileNameMod) End If End If ' If NeedDxf = True Then HideShowTables(Session, Model1, 1) ' End If If NeedDxf = False And NeedDWG = False And NeedTiff = False And sheetParamNeeded = False And printNeeded = False Then LapokSzama = 1 End If For i = 1 To LapokSzama SheetOwner = Model1 Drawing.currentsheetnumber = i 'Lapszámok beírása WriteSheetNum(Model1) '----- 'DXF Készítése ha szükséges If NeedDxf = True Then HandleNames(FileNameMod, y, i, ".DXF", Model1) CreateDXF(Model1, FileNameMod) End If If NeedDWG = True Then HandleNames(FileNameMod, y, i, ".DWG", Model1) CreateDWG(Model1, FileNameMod, Session) End If 'Create Tiff if needed If NeedTiff = True Then HandleNames(FileNameMod, y, i, ".Tif", Model1) CreateTiff(Session, Drawing, i, i, FileNameMod, Model1) End If '--------------------- Calculate sheetsize for print Try Dim iFormatDrawing As IpfcModelDescriptor iFormatDrawing = SheetOwner.GetSheetFormatDescr(i) Dim NameOfSheet As String = iFormatDrawing.InstanceName(iFormatDrawing.InstanceName.Length - 4) Dim A01234 As String = iFormatDrawing.InstanceName.IndexOf("A?") Dim regex As New RegularExpressions.Regex("A\d") Dim FormatString As String = regex.Match(iFormatDrawing.InstanceName).Value NameOfSheet = FormatString.Substring(1, 1) Dim e_int As Integer e_int = 2 ^ CInt(NameOfSheet) Dim model2d As IpfcModel2D Dim view2d As IpfcView2D Dim dview As CpfcView2Ds Dim model2 As IpfcModel Dim ListOfViewSheets As New List(Of Integer) Dim SheetNumberIndex As New List(Of Integer) Dim ViewCount As Single Dim IndexOfCurrentSheetFirstView As Integer model2d = Model1 dview = model2d.List2DViews() ViewCount = dview.Count For z = 0 To ViewCount - 1 view2d = (dview(z)) ListOfViewSheets.Add(view2d.GetSheetNumber) Next If i = 0 Then i = 1 IndexOfCurrentSheetFirstView = ListOfViewSheets.IndexOf(i) i = 0 Else IndexOfCurrentSheetFirstView = ListOfViewSheets.IndexOf(i) End If view2d = dview(IndexOfCurrentSheetFirstView) model2 = view2d.GetModel Dim SheetScale As Double = SheetOwner.GetSheetScale(i, model2) Dim Print_value As Double = e_int * 10 * SheetScale '--------------------- Calculate sheetsize for print END If printNeeded = True Then HandleNames(FileNameMod, y, i, ".Tif", Model1) Printtoprinter(Session, Drawing, i, i, FileNameMod, Model1, Print_value) End If Catch ex As Exception MsgBox(ex.Message) End Try Next i ' MsgBox(workDir) 'Log fileok törlése If NeedDxf = True Or NeedDWG = True Then If My.Computer.FileSystem.GetFiles(workDir, FileIO.SearchOption.SearchTopLevelOnly, "*.log.*").Count > 0 Then 'ha nem sikerült dxf-t csinálni, akkor ne csináljon semmit Dim logpath As String If autofolder = True Then logpath = workDir Else logpath = folderpicked End If Kill(logpath & "\*log*") End If End If If excelPrintNeeded = True Then folderpicked = Path.GetTempPath HandleNames(FileNameMod, 0, 0, ".xls", Model1) CreateExcel(Session, FileNameMod) PrintExcel(FileNameMod) End If End Sub 'Handles all the nameing sintax for every file XLS,DXF,PDF and TIFF Private Sub HandleNames(ByRef FileNameMod As String, y As Single, i As Single, Ext As String, model1 As IpfcModel) Dim model2d As IpfcModel2D Dim view2d As IpfcView2D Dim dview As CpfcView2Ds Dim model2 As IpfcModel Dim ListOfViewSheets As New List(Of Integer) Dim SheetNumberIndex As New List(Of Integer) Dim ViewCount As Single Dim FilePathMod As String Dim FileNamesWOExtention As String ' Dim FileNameOnlyBatchNumber As String ' Dim sResult As String Dim IndexOfCurrentSheetFirstView As Integer model2d = model1 dview = model2d.List2DViews() ViewCount = dview.Count For z = 0 To ViewCount - 1 view2d = (dview(z)) ListOfViewSheets.Add(view2d.GetSheetNumber) Next If i = 0 Then i = 1 IndexOfCurrentSheetFirstView = ListOfViewSheets.IndexOf(i) i = 0 Else IndexOfCurrentSheetFirstView = ListOfViewSheets.IndexOf(i) End If Console.WriteLine(ListOfViewSheets.IndexOf(i)) If IndexOfCurrentSheetFirstView >= 0 Then view2d = dview(IndexOfCurrentSheetFirstView) model2 = view2d.GetModel sresult = model2.FullName FileNamesWOExtention = (FileNames(y).Substring(0, FileNames(y).Length - 4)) FileNamesWOExtention = sresult Else FileNamesWOExtention = "NO_VIEW_ON_SHEET" End If FilePathMod = folderpicked If autofolder = True Then FilePathMod = workDir Else workDir = FilePathMod End If NameList.Add(FilePathMod + FileNamesWOExtention + Ext) Dim SameModellNumber As Integer = NameList.Where(Function(value) value = (FilePathMod + FileNamesWOExtention + Ext)).Count Dim SamemodelnumberStr As String If SameModellNumber <> 1 Then SamemodelnumberStr = "_" + CStr(SameModellNumber) Else SamemodelnumberStr = "" End If Dim FirstCharacter As Integer = FileNamesWOExtention.IndexOf("<") Console.WriteLine(FirstCharacter) If FirstCharacter > 0 Then FileNamesWOExtention = Strings.Left(FileNamesWOExtention, FirstCharacter) End If Console.WriteLine(FileNameMod) If namingsyntax = "stefani" = True Then FileNameMod = FilePathMod + FileNamesWOExtention + SamemodelnumberStr + Ext ' " _" + CStr(i) + Else Dim AudiRajzSzamStr As String = "" ReadParam(model1, "AUDI_RAJZSZAM", AudiRajzSzamStr) Try AudiRajzSzamStr = AudiRajzSzamStr.Substring(0, 3) + "000-" + AudiRajzSzamStr.Substring(3, 3) + "-" + AudiRajzSzamStr.Substring(7, 6) + "-001" Catch ex As Exception MsgBox("Az audi szám nem megfelelő formátum.") Environment.Exit(0) End End Try If Ext = ".xls" Then FileNameMod = FilePathMod + AudiRajzSzamStr + "_" + "stl" + Ext Else FileNameMod = FilePathMod + AudiRajzSzamStr + "_" + i.ToString("000") + Ext End If FileNameMod = FileNameMod.ToUpper End If ProgressTextstr = Path.GetFileName(FileNameMod) BackgroundWorker1.ReportProgress(0, Nothing) FileNameModTimer = FileNameMod End Sub Public Sub HandleTable(session As IpfcBaseSession, ByRef TableContent(,) As String, MoreThanOneTable As Integer) Dim selection As IpfcSelection = Nothing Dim selections As New CpfcSelections Dim selectionOptions As IpfcSelectionOptions Dim TableCell As IpfcTableCell Dim NonBaseSession As IpfcSession Dim iTableOwner As IpfcTableOwner NonBaseSession = session iTableOwner = session.CurrentModel Dim row As Integer Dim col As Integer Dim TableRowCount As Integer Dim TableCoulomnCount As Integer Dim Cstringseq As New Cstringseq Dim CellValues As String ' str1 = " Creo segéd program" 'str2 = "" ' ChooseTable(session, session.CurrentModel, MoreThanOneTable, table) If MoreThanOneTable > 1 Then HandleWindow.FocusWindowM("In", "fo") ProgressTextstr = "Válassz táblázatot!" BackgroundWorker1.ReportProgress(0) ' Dim UISO As IpfcMessageDialogOptions ' UISO = (New CCpfcMessageDialogOptions) ' UISO.DialogLabel = "Válassz táblázatot!" NonBaseSession.UIShowMessageDialog("Válassz táblázatot!", Nothing) selectionOptions = (New CCpfcSelectionOptions).Create("dwg_table") selectionOptions.MaxNumSels = 1 ' Try selections = session.Select(selectionOptions, Nothing) selection = selections.Item(0) ' Catch ex As Exception ' MsgBox(ex.Message) ' Exit Sub ' End Try ' Dim name1 As String = "Creo Parametric" ' Dim name2 As String = "(Active)" ' HandleWindow.FocusWindowM(name2, name1) table = selection.SelItem End If HandleWindow.FocusWindowM("Dokumentáció", "készítő") ' table = iTableOwner.GetTable(2) TableCoulomnCount = table.GetColumnCount() TableRowCount = table.GetRowCount() ReDim TableContent(TableRowCount - 1, TableCoulomnCount) For col = 1 To TableCoulomnCount For row = 7 To TableRowCount TableCell = (New CCpfcTableCell).Create(row, col) Try Cstringseq = table.GetText(TableCell, 0) CellValues = Cstringseq.Item(0) ' MsgBox(Cstringseq.Item(0)) TableCell = (New CCpfcTableCell).Create(row, col) TableContent(row - 4, col) = CellValues Catch ex As Exception TableContent(row - 4, col) = " " End Try ' MsgBox(row) Next Next SHMNum = CellToString(table, 1, 5) MachineName = CellToString(table, 2, 7) SHMDate = CellToString(table, 3, 7) SubMachineName = CellToString(table, 1, 7) 'AudiNum = CellToString(table, 1, 7) NameT = CellToString(table, 3, 5) 'table.Erase() End Sub Private Sub HandleExcel(model1 As IpfcModel, FilnameMod As String, TableContent(,) As String) xlApp = New Excel.Application xlWorkBook = xlApp.Workbooks.Open(FilnameMod) xlWorkSheet = xlWorkBook.Worksheets("Darabjegyzék") xlApp.DisplayAlerts = False Dim RowCount As Integer = TableContent.GetLength(0) - 1 Dim ColCount As Integer = TableContent.GetLength(1) - 1 'Fill V-numbers...I think For row = 3 To RowCount - 3 Console.WriteLine(TableContent(row, 7)) ' If TableContent(row, 7).Length < 2 Then ' TableContent(row, 7) = " " ' End If 'Ha "V-"-vel kezdődik a string akkor kitölti a ' If TableContent(row, 7).Substring(0, 2) <> "V-" Then ' For col = 1 To ColCount ' xlWorkSheet.Cells(row + 5, col) = TableContent(row, col) 'xt ' Else Dim u As Integer = 1 xlWorkSheet.Cells(row + u, 1) = TableContent(row, 1) xlWorkSheet.Cells(row + u, 2) = TableContent(row, 2) xlWorkSheet.Cells(row + u, 3) = TableContent(row, 3) xlWorkSheet.Cells(row + u, 4) = TableContent(row, 4) xlWorkSheet.Cells(row + u, 5) = TableContent(row, 5) xlWorkSheet.Cells(row + u, 6) = TableContent(row, 6) xlWorkSheet.Cells(row + u, 7) = TableContent(row, 7) xlWorkSheet.Cells(row + u, 8) = TableContent(row, 8) xlWorkSheet.Cells(row + u, 9) = TableContent(row, 9).Replace("n", "ø") ' xlWorkSheet.Cells(row + u, 9) = TableContent(row, 9) xlWorkSheet.Cells(row + u, 10) = TableContent(row, 10) ' End If ' Next 'Do I really need this ?! SHMNum = CellToString(table, 1, 5) NameT = CellToString(table, 3, 5) MachineName = CellToString(table, 3, 7) SHMDate = CellToString(table, 4, 7) SubMachineName = CellToString(table, 2, 7) AudiNum = CellToString(table, 1, 7) 'A fejléc kitöltése xlWorkSheet.Cells(1, 5) = SHMNum ' xlWorkSheet.Cells(4, 10) = SHMNum xlWorkSheet.Cells(3, 5) = NameT xlWorkSheet.Cells(4, 5) = NameT xlWorkSheet.Cells(3, 7) = MachineName xlWorkSheet.Cells(4, 7) = SHMDate xlWorkSheet.Cells(4, 9) = SHMDate xlWorkSheet.Cells(2, 7) = SubMachineName If namingsyntax = "stefani" Then xlWorkSheet.Cells(1, 7) = "" ElseIf namingsyntax = "audi" Then xlWorkSheet.Cells(1, 7) = AudiNum Else Try Dim tempparam As String = "" ReadParam(model1, "BESTELLER", tempparam) xlWorkSheet.Cells(1, 7) = tempparam Catch ex As Exception xlWorkSheet.Cells(1, 7) = " " End Try End If 'Delete useless cells xlWorkSheet.Range(xlWorkSheet.Cells(RowCount + 6, 1), xlWorkSheet.Cells(3000, 10)).Clear() If namingsyntax = "audi" = True Then xlApp.Run("Atalakitas_doksihoz") 'Check for hianyzik in "Herstellaradressen xlWorkSheet = xlWorkBook.Worksheets("Herstelleradressen") ddas = IsNothing(xlWorkSheet.Range(xlWorkSheet.Cells(1, 1), xlWorkSheet.Cells(100, 10)).Find("#HIÁNYZIK")) ' If ddas = False Then 'End If End If If xlstype = "hanon" Then xlApp.Run("Atalakitas_doksihoz_hanon") End If 'Save and close, set display alerts back to true xlWorkBook.Save() xlWorkBook.Close() : xlApp.Quit() xlApp.DisplayAlerts = True 'Clear shit System.Runtime.InteropServices.Marshal.ReleaseComObject(xlApp) : xlApp = Nothing System.Runtime.InteropServices.Marshal.ReleaseComObject(xlWorkBook) : xlWorkBook = Nothing System.Runtime.InteropServices.Marshal.ReleaseComObject(xlWorkSheet) : xlWorkSheet = Nothing End Sub 'Create tiff,dxf and pdf Private Sub CreateDXF(model1 As IpfcModel, FileNameMod As String) Try 'Create a DXF export instruction Dim myDXFInstr = (New CCpfcDXFExportInstructions).Create 'Export the drawing to dxf model1.Export(FileNameMod, myDXFInstr) FileSystem.Rename(FileNameMod.ToLower, FileNameMod.ToUpper) 'Átnevezés mert imre szólt hogy a "c" nagy betüvel legyen... dxfCreated.Add(Path.GetFileName(FileNameMod) & " elkészült.") 'Hiba esetén a felugró ablakba beírni a mgefelelő adatokat Catch ex As Exception Dim TryError As String If ex.Message = "pfcExceptions::XStringTooLong; argument: FileName string: " & FileNameMod & " maximum length: 216" Then TryError = "Az elérési út túl hosszú!" Else TryError = ex.Message End If ' Console.WriteLine(ex.Message) ' Console.WriteLine("pfcExceptions::XStringTooLong; argument: FileName string: " & FileNameMod & " maximum lenght: 216") dxfCreated.Add(Path.GetFileName(FileNameMod) & " nem készült el, a következő hiba üzenettel: " & TryError) HibakSzama = HibakSzama + 1 End Try End Sub Private Sub CreateDWG(model1 As IpfcModel, FileNameMod As String, session As IpfcBaseSession) Dim OldWorkDir = session.GetCurrentDirectory ' MsgBox(Path.GetFileNameWithoutExtension(FileNameMod)) ' MsgBox(Path.GetDirectoryName(FileNameMod)) session.ChangeDirectory(Path.GetDirectoryName(FileNameMod)) Dim macroStrings As String macroStrings = "~ Select `main_dlg_cur` `appl_casc`;\" macroStrings = macroStrings & "~ Select `main_dlg_cur` `appl_menu.left_pane.saveas_casc`;\" macroStrings = macroStrings & "~ Close `main_dlg_cur` `appl_menu.left_pane.saveas_casc`;\" macroStrings = macroStrings & "~ Close `main_dlg_cur` `appl_casc`;\" macroStrings = macroStrings & "~ Activate `main_dlg_cur` `appl_menu.left_pane.save_a_copy_button`;\" macroStrings = macroStrings & "~ Open `file_saveas` `type_option`;~ Close `file_saveas` `type_option`;\" macroStrings = macroStrings & "~ Select `file_saveas` `type_option` 1 `db_560`;\" macroStrings = macroStrings & "~ Update `file_saveas` `Inputname` `" + Path.GetFileNameWithoutExtension(FileNameMod) + "`;\" macroStrings = macroStrings & "~ Activate `file_saveas` `OK`;~ Activate `export_2d_dlg` `OK_Button`;" macroStrings = macroStrings & "mapkey(continued) ~ Activate `UI Message Dialog` `ok`;" session.RunMacro(macroStrings) session.ChangeDirectory(Path.GetDirectoryName(FileNameMod)) End Sub Private Sub CreatePdf(session As IpfcBaseSession, model1 As IpfcModel, Filename As String) Try Dim PDFExportInstrCreate As New CCpfcPDFExportInstructions Dim PDFExportInstr As IpfcPDFExportInstructions PDFExportInstr = PDFExportInstrCreate.Create Dim PDF_Options As New pfcls.CpfcPDFOptions 'Set Stroke All Fonts PDF Option If NeedStroke = True Then Dim PDFOptionCreate_SAF As New CCpfcPDFOption Dim PDFOption_SAF As IpfcPDFOption PDFOption_SAF = PDFOptionCreate_SAF.Create PDFOption_SAF.OptionType = EpfcPDFOptionType.EpfcPDFOPT_FONT_STROKE Dim newArg_SAF As New CMpfcArgument PDFOption_SAF.OptionValue = newArg_SAF.CreateIntArgValue(EpfcPDFFontStrokeMode.EpfcPDF_STROKE_ALL_FONTS) Call PDF_Options.Append(PDFOption_SAF) End If ' Set COLOR_DEPTH value (Set EpfcPDF_CD_MONO to have Black & White output) Dim PDFOptionCreate_CD As New CCpfcPDFOption Dim PDFOption_CD As IpfcPDFOption PDFOption_CD = PDFOptionCreate_CD.Create PDFOption_CD.OptionType = EpfcPDFOptionType.EpfcPDFOPT_COLOR_DEPTH Dim newArg_CD As New CMpfcArgument PDFOption_CD.OptionValue = newArg_CD.CreateIntArgValue(EpfcPDFColorDepth.EpfcPDF_CD_MONO) Call PDF_Options.Append(PDFOption_CD) ' Set PDF EpfcPDFOPT_LAUNCH_VIEWER(Set FALSE Not to Launch Adobe reader) Dim PDFOptionCreate_LV As New CCpfcPDFOption Dim PDFOption_LV As IpfcPDFOption PDFOption_LV = PDFOptionCreate_LV.Create PDFOption_LV.OptionType = EpfcPDFOptionType.EpfcPDFOPT_LAUNCH_VIEWER Dim newArg_LV As New CMpfcArgument PDFOption_LV.OptionValue = newArg_LV.CreateBoolArgValue(False) Call PDF_Options.Append(PDFOption_LV) 'Set Output PDF File Name Dim TempPath As String = Path.GetTempPath() & Path.GetFileName(Filename) PDFExportInstr.FilePath = Filename PDFExportInstr.Options = PDF_Options Try Dim fOpen As IO.FileStream = IO.File.Open("your file name", IO.FileMode.Open, IO.FileAccess.Read, IO.FileShare.None) fOpen.Close() fOpen.Dispose() fOpen = Nothing Catch e1 As IO.IOException 'File Open by some one else.. Catch e2 As Exception End Try If System.IO.File.Exists(Filename) Then File.Delete(Filename) End If model1.Export(PDFExportInstr.FilePath, PDFExportInstr) ' File.Move(TempPath, Filename) pdfFiles.Add(Filename) pdfCreated.Add(Path.GetFileName(Filename) & " elkészült.") ' pdfCreated = pdfCreated + 1 Catch ex As Exception Dim TryError As String If ex.Message = "pfcExceptions::XStringTooLong; argument: FileName string: " & Filename & " maximum length: 216" Then TryError = "Az elérési út túl hosszú!" Else TryError = ex.Message End If pdfCreated.Add(Path.GetFileName(Filename) & " nem készült el, a következő hiba üzenettel: " & TryError) HibakSzama = HibakSzama + 1 End Try End Sub Private Sub CreateTiff(ByRef session As IpfcBaseSession, ByRef Drawing As IpfcDrawing, ByVal StartSheet As Integer, ByVal EndSheet As Integer, Filename As String, model1 As IpfcModel) Try session.SetConfigOption("display_planes", "no") session.SetConfigOption("display_axes", "no") session.SetConfigOption("datum_point_display", "no") session.SetConfigOption("display_coord_sys", "no") ' Place your company standard plot configuration files (*.pcf) in a directory and ' set it's full path as value to Creo configuration option pro_plot_config_dir. ' Example: pro_plot_config_dir C:\Engineering_Standards\Creo_Standards\Plot_configs\ ' Creo will find any *.pcf file just by its file name if it exists in one of the below mentioned locations ' 1. In Current Working Directory ' 2. In Directory set by configuration option pro_plot_config_dir ' 2. In \text\plot_config Directory Dim pcfOptions As IpfcPrinterPCFOptions Dim printerOptions As IpfcPrinterInstructions 'pfcFileName length should be max 32 chars excluding file extension. 'If exceeds 32 chars, results in exception xToolkitNotFound / xToolkitStringTooLong Dim model2d As IpfcModel2D model2d = model1 pcfOptions = session.GetPrintPCFOptions("ms_print_mgr_2.pcf", model2d) printerOptions = (New CCpfcPrinterInstructions).Create() printerOptions.ModelOption = pcfOptions.ModelOption printerOptions.PlacementOption = pcfOptions.PlacementOption printerOptions.PrinterOption = pcfOptions.PrinterOption printerOptions.WindowId = session.GetModelWindow(Drawing).GetId() printerOptions.ModelOption.Sheets = EpfcPrintSheets.EpfcPRINT_SELECTED_SHEETS printerOptions.ModelOption.FirstPage = StartSheet printerOptions.ModelOption.LastPage = EndSheet ' Set required output print paper size. ' Do this only if you want any sheet size to be plot to single paper size. Dim iPlotPaperSize As New CCpfcPlotPaperSize Dim printSize As IpfcPrintSize printSize = (New CCpfcPrintSize).Create() printSize.Height = 841 printSize.Width = 1189 printSize.PaperSize = iPlotPaperSize.A0SIZEPLOT printerOptions.PrinterOption.PaperSize = printSize 'printerOptions.PrinterOption.PaperSize printerOptions.ModelOption.Mdl = model2d 'printerOptions.PrinterOption.FileName = model2d.InstanceName Dim ExportInstr As IpfcExportInstructions ExportInstr = CType(printerOptions, IpfcExportInstructions) model1.Export(Filename, ExportInstr) FileSystem.Rename(Filename.ToLower, Filename.ToUpper) tiffCreated.Add(Path.GetFileName(Filename) + " elkészült.") Catch ex As Exception Dim TryError As String If ex.Message = "pfcExceptions::XStringTooLong; argument: FileName string: " & Filename & " maximum length: 216" Then TryError = "Az elérési út túl hosszú!" Else TryError = ex.Message End If tiffCreated.Add(Path.GetFileName(Filename) & " nem készült el, a következő hiba üzenettel: " & TryError) HibakSzama = HibakSzama + 1 End Try End Sub Private Sub CreateExcel(session As IpfcBaseSession, FilnameMod As String) Dim TableContent(,) As String = Nothing Dim MoreThanOneTable As Integer = 0 ChooseTable(session, session.CurrentModel, MoreThanOneTable, table) If MoreThanOneTable = 0 Then Exit Sub End If HandleTable(session, TableContent, MoreThanOneTable) ' Generálja a temp fájl elérési útját Dim tempPath As String = System.IO.Path.Combine(System.IO.Path.GetTempPath(), Path.GetFileName(FilnameMod)) Dim currentDirectory As String = Directory.GetCurrentDirectory() ' Gets the running directory currentDirectory = "C:\Creo_config\06 - Creo\18 - Utilities" Dim sourcePath As String = Path.Combine(currentDirectory, "Darabjegyzek.xlsm") ' Másolja az XLS-t az ideiglenes mappába File.Copy(sourcePath, tempPath, True) ' Kiírja a Creo táblázat tartalmát az XLS-be HandleExcel(session.CurrentModel, tempPath, TableContent) ' Ellenőrzés és visszajelzés If ddas = True Then xlsCreated.Add(Path.GetFileName(FilnameMod) & " elkészült.") Else xlsCreated.Add(Path.GetFileName(FilnameMod) & " elkészült." & " - Cég információk hiányoznak!") HibakSzama = HibakSzama + 1 End If ' Végleges fájl elérési útjának generálása Dim finalDestination As String = FilnameMod.ToUpper() ' Másolja az ideiglenes fájlt a végleges célhelyre File.Copy(tempPath, finalDestination & "M", True) End Sub 'Printing each file to printer Private Const BM_CLICK As Integer = &HF5 Private Const WM_SETFOCUS As Integer = &H7 Private Shared Function FindWindowExW(ByVal hWndParent As IntPtr, ByVal hWndChildAfter As IntPtr, ByVal lpszClass As String, ByVal lpszWindow As String) As IntPtr End Function Private Shared Function SendMessageW(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer End Function Private Sub Printtoprinter(ByRef session As IpfcBaseSession, ByRef Drawing As IpfcDrawing, ByVal StartSheet As Integer, ByVal EndSheet As Integer, Filename As String, model1 As IpfcModel, Print_Value As Double) 'Dim the used variables Dim pcfOptions As IpfcPrinterPCFOptions Dim printerOptions As IpfcPrinterInstructions Dim ExportInstr As IpfcExportInstructions 'Turning off displayed planes,axes,points and coordiante systems session.SetConfigOption("display_planes", "no") session.SetConfigOption("display_axes", "no") session.SetConfigOption("datum_point_display", "no") session.SetConfigOption("display_coord_sys", "no") 'Choosing and using the PCF file" If Print_Value > 15 Then 'a4 pcfOptions = session.GetPrintPCFOptions("CDC5520_A4.pcf", model1) ElseIf Print_Value > 3 Then 'A3 pcfOptions = session.GetPrintPCFOptions("CDC5520_A3.pcf", model1) ElseIf Print_Value > 1 Then 'A2 pcfOptions = session.GetPrintPCFOptions("CDC5520_A2.pcf", model1) ElseIf Print_Value > 0 Then 'A1 pcfOptions = session.GetPrintPCFOptions("CDC5520_A1.pcf", model1) Else 'A0 pcfOptions = session.GetPrintPCFOptions("CDC5520_A0.pcf", model1) End If printerOptions = (New CCpfcPrinterInstructions).Create() printerOptions.ModelOption = pcfOptions.ModelOption printerOptions.PlacementOption = pcfOptions.PlacementOption printerOptions.PrinterOption = pcfOptions.PrinterOption printerOptions.WindowId = session.GetModelWindow(Drawing).GetId() 'Choosing the sheets to print, the reason why it is printed one by one is to use the right naming syntax printerOptions.ModelOption.Sheets = EpfcPrintSheets.EpfcPRINT_SELECTED_SHEETS printerOptions.ModelOption.FirstPage = StartSheet printerOptions.ModelOption.LastPage = EndSheet 'Choosing the model to print printerOptions.ModelOption.Mdl = model1 printerOptions.PrinterOption.FileName = model1.InstanceName 'Printing the document (Don't mind that it is called export, for some fucking reason) ExportInstr = CType(printerOptions, IpfcExportInstructions) If Print_Value > 3 Then 'A3 ' EZ VALAMI OKNÁL FOGVA BACKGROUND WOERKERBEN VOLT ???? BackgroundWorker3.RunWorkerAsync() Else MsgBox("Kérlek válaszd ki a nyomtató beállításokat, javasolt a Canon plotter használata.") End If model1.Export(Filename, ExportInstr) End Sub 'Write parameters and sheetnumber Private Sub WriteParam(iFeature As IpfcModel, iParamValueStr As String, iParamName As String) Dim iParamOwner As IpfcParameterOwner Dim iParam As IpfcParameter Dim iBaseParam As IpfcBaseParameter = Nothing Dim iParamValue As IpfcParamValue Dim MItem As New CMpfcModelItem 'Paraméter string érték paraméter value értékké alakítása iParamValue = MItem.CreateStringParamValue(iParamValueStr) 'Paraméter tulajdonos beállítása (mi tartalmazza a praméteret(Feature,Modell stb.) iParamOwner = iFeature If iParamOwner.GetParam(iParamName) Is Nothing Then iParamOwner.CreateParam(iParamName, iParamValue) Else Try iParam = iParamOwner.GetParam(iParamName) iBaseParam = iParam iBaseParam.Value = iParamValue Catch ex As Exception Console.WriteLine("Paraméterek beírása nem történt meg. (Zárt..)") End Try End If End Sub Private Sub ReadParam(iFeature As IpfcModel, IparamName As String, ByRef iParamValueStr As String) Dim iParamOwner As IpfcParameterOwner Dim iParam As IpfcParameter Dim iBaseParam As IpfcBaseParameter = Nothing Dim iParamValue As IpfcParamValue Dim MItem As New CMpfcModelItem ' MsgBox(iFeature.FileName) iParamOwner = iFeature ' MsgBox(IparamName) iParam = iParamOwner.GetParam(IparamName) iBaseParam = iParam Console.WriteLine("param name: " + IparamName) iParamValue = iBaseParam.Value Console.WriteLine("value: " + iParamValue.StringValue) iParamValueStr = iParamValue.StringValue End Sub 'drw Split sub Private Sub AutomatedFolderPick(ByVal session As IpfcBaseSession) 'WTF is this? Dim WorkingDir As String WorkingDir = session.GetCurrentDirectory() ' Dim whateverthefuck As String = Dim WorkingDirPerIndex As Single WorkingDirPerIndex = GetNthIndex(WorkingDir, "\", 4) folderpicked = WorkingDir End Sub 'Functions Private Function MergePdfFiles(ByVal pdfFiles As List(Of String), ByVal outputPath As String) As Boolean Dim result As Boolean = False Dim pdfCount As Integer = 0 'total input pdf file count Dim f As Integer = 0 'pointer to current input pdf file Dim fileNamePdf As String Dim reader As iTextSharp.text.pdf.PdfReader = Nothing Dim pageCount As Integer = 0 Dim pdfDoc As iTextSharp.text.Document = Nothing 'the output pdf document Dim writer As PdfWriter = Nothing Dim cb As PdfContentByte = Nothing Dim page As PdfImportedPage = Nothing Dim rotation As Integer = 0 Try pdfCount = pdfFiles.Count If pdfCount > 0 Then 'Open the 1st item in the array PDFFiles fileNamePdf = pdfFiles(f) reader = New iTextSharp.text.pdf.PdfReader(fileNamePdf) 'Get page count pageCount = reader.NumberOfPages pdfDoc = New iTextSharp.text.Document(reader.GetPageSizeWithRotation(1), 18, 18, 18, 18) writer = PdfWriter.GetInstance(pdfDoc, New FileStream(outputPath, FileMode.OpenOrCreate)) With pdfDoc .Open() End With 'Instantiate a PdfContentByte object cb = writer.DirectContent 'Now loop thru the input pdfs While f < pdfCount 'Declare a page counter variable Dim i As Integer = 0 'Loop thru the current input pdf's pages starting at page 1 While i < pageCount i += 1 'Get the input page size pdfDoc.SetPageSize(reader.GetPageSizeWithRotation(i)) 'Create a new page on the output document pdfDoc.NewPage() 'If it is the 1st page, we add bookmarks to the page 'Now we get the imported page page = writer.GetImportedPage(reader, i) 'Read the imported page's rotation rotation = reader.GetPageRotation(i) 'Then add the imported page to the PdfContentByte object as a template based on the page's rotation If rotation = 90 Then cb.AddTemplate(page, 0, -1.0F, 1.0F, 0, 0, reader.GetPageSizeWithRotation(i).Height) ElseIf rotation = 270 Then cb.AddTemplate(page, 0, 1.0F, -1.0F, 0, reader.GetPageSizeWithRotation(i).Width + 60, -30) Else cb.AddTemplate(page, 1.0F, 0, 0, 1.0F, 0, 0) End If End While 'Increment f and read the next input pdf file f += 1 If f < pdfCount Then fileNamePdf = pdfFiles(f) reader = New iTextSharp.text.pdf.PdfReader(fileNamePdf) pageCount = reader.NumberOfPages End If End While 'When all done, we close the document so that the pdfwriter object can write it to the output file pdfDoc.Close() result = True End If ' Print() reader.Close() Catch ex As Exception Return False End Try Return result End Function Private Function GetNthIndex(searchString As String, charToFind As Char, n As Integer) As Integer Dim charIndexPair = searchString.Select(Function(c, i) New With {.Character = c, .Index = i}) _ .Where(Function(x) x.Character = charToFind) _ .ElementAtOrDefault(n - 1) Return If(charIndexPair IsNot Nothing, charIndexPair.Index, -1) End Function Private Sub Connect(ByRef session As IpfcBaseSession, ByRef conn As IpfcAsyncConnection) Dim cac As New CCpfcAsyncConnection 'Kapcsolódás creo-hoz ' Dim iAsyncConnection As IpfcAsyncConnection = Nothing ' Dim iConnection As IpfcConnectionId = iAsyncConnection.GetConnectionId conn = cac.Connect("", "", ".", 5) session = conn.Session End Sub Private Function CellToString(table As IpfcTable, row As Integer, col As Integer) Dim TableCell As IpfcTableCell TableCell = (New CCpfcTableCell).Create(row, col) Dim Cstringseq As New Cstringseq Dim strg As String Try Cstringseq = table.GetText(TableCell, 0) strg = Cstringseq.Item(0) Catch ex As Exception strg = "" End Try Return strg End Function 'Background worker so I can show names while creating the files Private Sub BackgroundWorker1_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork ' Private Sub Backgroundworker1_DoWork(ByVal sender As Object, ByVal e As DoWorkEventArgs) 'Run the whole whole create document sub CreateDocuments() sresult = String.Join(Environment.NewLine, pdfCreated.ToArray()) & Environment.NewLine _ & String.Join(Environment.NewLine, dxfCreated.ToArray()) & Environment.NewLine _ & String.Join(Environment.NewLine, DWGCreated.ToArray()) & Environment.NewLine _ & String.Join(Environment.NewLine, tiffCreated.ToArray()) & Environment.NewLine _ & String.Join(Environment.NewLine, xlsCreated.ToArray()) End Sub Private Sub Backgroundworker2_ProgressChanged(ByVal sender As Object, ByVal e As ProgressChangedEventArgs) Handles BackgroundWorker2.ProgressChanged Progressbar.Value = e.ProgressPercentage End Sub Private Sub Backgroundworker1_ProgressChanged(ByVal sender As Object, ByVal e As ProgressChangedEventArgs) Handles BackgroundWorker1.ProgressChanged ProgressText.Content = ProgressTextstr End Sub Private Sub Backgroundworker2_DoWork(ByVal sender As Object, ByVal e As DoWorkEventArgs) Handles BackgroundWorker2.DoWork For pbs = 0 To 100 BackgroundWorker2.ReportProgress(pbs, Nothing) If pbs = 99 Then pbs = 0 End If If BackgroundWorker1.IsBusy = False Then pbs = 100 BackgroundWorker2.ReportProgress(0, Nothing) End If Threading.Thread.Sleep(50) Next End Sub Private Sub BackgroundWorker1_RunWorkerCompleted(ByVal sender As Object, ByVal e As RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted ProgressText.Content = "" MainGrid.IsEnabled = True Dim window2 As New Form3 ' MsgBox(sresult) window2.ShowDialog() If params.Contains("-arg") Then Environment.Exit(0) End End If End Sub Private Sub WriteSheetNum(model1 As IpfcModel) 'Cauction! I only undestand half of it...if you manage to undestand, it you are the first one to! It was a trial and error process for 2 hours If NeedSheetNumbers = True Then If i <> 1 Then Dim model2 As IpfcModel model2 = Nothing Dim SheetNumberIndex As New List(Of Integer) Dim tol As Integer = 0 Dim ig As String = 0 GetDrawingModel(model1, model2) tol = SheetNumber Dim u As Integer = i - 2 If u > 0 Then If models(u - 1).FileName.Length > 13 Then 'MsgBox(Strings.Left(models(u).FileName, 16) + Strings.Left(models(u - 1).FileName, 16)) If Strings.Left(models(u).FileName, 16) = Strings.Left(models(u - 1).FileName, 16) Then ig = SheetNumber + 1 q = q + 1 Console.WriteLine(q) tol = tol - q Console.WriteLine(tol) Else ig = 0 q = 0 End If Console.WriteLine("Tol:" & tol & "Ig:" & ig) End If End If Dim SheetNumberStr As String SheetPartList.Add(model2.FileName) If ig = 0 Then SheetNumberStr = CStr(tol + 1) Else SheetNumberStr = CStr(tol + 1) & "-" & CStr(ig) End If ' MsgBox(models(u - j).FileName) WriteParam(models(u - q), SheetNumberStr, "lap") SheetNumber = SheetNumber + 1 End If End If End Sub Private Sub GetDrawingModel(model1 As IpfcModel, ByRef model2 As IpfcModel) Dim view2d As IpfcView2D Dim dview As CpfcView2Ds Dim model2d As IpfcModel2D Dim IndexOfCurrentSheetFirstView As Integer Dim ViewCount As Single Dim ListOfViewSheets As New List(Of Integer) model2d = model1 dview = model2d.List2DViews() ViewCount = dview.Count For z = 0 To ViewCount - 1 view2d = (dview(z)) ListOfViewSheets.Add(view2d.GetSheetNumber) Next If i = 0 Then i = 1 IndexOfCurrentSheetFirstView = ListOfViewSheets.IndexOf(i) i = 0 Else IndexOfCurrentSheetFirstView = ListOfViewSheets.IndexOf(i) End If view2d = dview(IndexOfCurrentSheetFirstView) model2 = view2d.GetModel models.Add(model2) End Sub Private Sub ChooseTable(session As IpfcBaseSession, model1 As IpfcModel, ByRef MoreThanOne As Integer, ByRef iTableRef As IpfcTable) Dim iTables As IpfcTables Dim iTableOnwer As IpfcTableOwner iTableOnwer = model1 iTables = iTableOnwer.ListTables Dim iTCells As IpfcTableCell iTCells = (New CCpfcTableCell).Create(2, 2) Dim Cstringseq As New Cstringseq Dim a As Integer = 0 'MsgBox(iTables.Count) For Each iTablea As IpfcTable In iTables Try Dim CellStr As String = CellToString(iTablea, 2, 5) 'MsgBox(CellStr) If CellStr = "Famex Tools Kft." Or CellStr = "Famex Tools" Then MoreThanOne = MoreThanOne + 1 iTableRef = iTablea End If Catch ex As Exception ' MsgBox(ex.Message) End Try Next ' MsgBox(iTableRef.GetRowCount) ' iLayer. End Sub Private Sub HideShowTables(session As IpfcBaseSession, model1 As IpfcModel, HideShow As Boolean) Dim iTables As IpfcTables Dim iTableOnwer As IpfcTableOwner iTableOnwer = model1 iTables = iTableOnwer.ListTables Dim iTCells As IpfcTableCell iTCells = (New CCpfcTableCell).Create(5, 7) Dim Cstringseq As New Cstringseq Dim iModelItems As IpfcModelItems Dim iLayer As IpfcLayer = Nothing iModelItems = CType(model1, IpfcModelItemOwner).ListItems(EpfcModelItemType.EpfcITEM_LAYER) Dim CheckLayers As Integer = 0 For Each iModelItem In iModelItems If iModelItem.GetName.ToString = "HIDETABLE" Then iLayer = iModelItem CheckLayers = 1 End If Next If CheckLayers = 0 Then iLayer = model1.CreateLayer("HideTable") End If iLayer.Status = 2 For Each iTablea As IpfcTable In iTables ' iTablea. Try Cstringseq = iTablea.GetText(iTCells, 0) If Cstringseq.Item(0) = "Stefani" Then If HideShow = True Then iLayer.AddItem(iTablea) Else iLayer.RemoveItem(iTablea) End If End If ' MsgBox(Cstringseq.Item(0)) Catch ex As Exception End Try Next ' iLayer. End Sub Public Shared Function gtranslate(ByVal inputtext As String, ByVal fromlangid As String, ByVal tolangid As String) As String inputtext = System.Web.HttpUtility.HtmlAttributeEncode(inputtext) Dim step1 As New WebClient step1.Encoding = Encoding.UTF8 Dim step2 As String = step1.DownloadString("https://translate.googleapis.com/translate_a/single?client=gtx&sl=auto&tl=" & tolangid & "&hl=" & fromlangid & "&dt=t&dt=bd&dj=1&source=icon&q=" & inputtext) Dim step3 As Newtonsoft.Json.Linq.JObject = JObject.Parse(step2) Dim step4 As String = step3.SelectToken("sentences[0]").SelectToken("trans").ToString() Return step4 End Function Private Sub Button3_Click(sender As Object, e As EventArgs) Dim dict As New Dictionary(Of String, String)() Dim fs As New FileStream("Serialized.ser", FileMode.Open) Dim MyFormatter As New BinaryFormatter() dict = MyFormatter.Deserialize(fs) fs.Close() dict.Remove(InputBox("dsad")) Dim MyFile As New FileStream("Serialized.ser", FileMode.Create, FileAccess.Write, FileShare.None) MyFormatter.Serialize(MyFile, dict) MyFile.Close() End Sub Private Sub TranslateNotes(model1 As IpfcModel, session As IpfcSession) Dim iModelIOwner As IpfcModelItemOwner = model1 Dim iModelItems As IpfcModelItems Dim IDNI As IpfcDetailNoteItem Dim DTLs As IpfcDetailTextLines Dim DTL As IpfcDetailTextLine Dim DTs As IpfcDetailTexts Dim DT As IpfcDetailText iModelItems = iModelIOwner.ListItems(EpfcModelItemType.EpfcITEM_DTL_NOTE) Dim countnote As Integer = 1 ' Dim reversedDictionary = dictionary.ToDictionary(Function(x) x.Value, Function(x) x.Key) ProgressTextstr = "Megjegyzések listázása" BackgroundWorker1.ReportProgress(0) For Each IMI As IpfcModelItem In iModelItems IDNI = IMI DTLs = IDNI.GetTextLines(0) DTL = DTLs.Item(0) DTs = DTL.Texts DT = DTs.Item(0) Dim dict As Dictionary(Of String, String) Dim MyFormatter As New BinaryFormatter() Dim fs As New FileStream("Serialized2.ser", FileMode.Open) dict = MyFormatter.Deserialize(fs) fs.Close() Dim sb As New System.Text.StringBuilder() Dim TranslatedText As String = "" Dim NewLine As String = "" Dim ReadFirst As Boolean = False If namingsyntax = "stefani" Then ElseIf namingsyntax = "audi" Then dict = dict.ToDictionary(Function(x) x.Value, Function(x) x.Key) End If If Not IDNI.GetAttachment.GetNoteAttachment.GetType = 2 Then For Each DLI As IpfcDetailTextLine In DTLs Console.WriteLine(DLI.Texts.Item(0).Text.Substring(0, DLI.Texts.Item(0).Text.Length - 1)) If dict.TryGetValue(DLI.Texts.Item(0).Text, NewLine) = True Then If ReadFirst = False Then TranslatedText = TranslatedText & NewLine Else TranslatedText = TranslatedText & Environment.NewLine & NewLine End If ' MsgBox(TranslatedText) Try IDNI.SetTextLines(StrstoTextlines(TranslatedText)) Catch ex As Exception End Try ElseIf dict.TryGetValue(DLI.Texts.Item(0).Text.Substring(0, DLI.Texts.Item(0).Text.Length - 1), NewLine) = True Then If ReadFirst = False Then TranslatedText = TranslatedText & NewLine Else TranslatedText = TranslatedText & Environment.NewLine & NewLine End If MsgBox(TranslatedText) Try IDNI.SetTextLines(StrstoTextlines(TranslatedText)) Catch ex As Exception End Try Else Exit For End If ReadFirst = True Next End If Next ' MsgBox("Fordítás kész!") End Sub Private Function StrstoTextlines(ByVal Texts As String) As CpfcDetailTextLines Dim detailText As IpfcDetailText Dim detailTexts As CpfcDetailTexts Dim textLine As IpfcDetailTextLine Dim i As Integer Dim Strs() As String StrstoTextlines = New CpfcDetailTextLines Strs = Split(Texts, Chr(10)) For i = 0 To Strs.Length - 1 detailText = (New CCpfcDetailText).Create(Strs(Strs.Length - i - 1)) detailTexts = New CpfcDetailTexts detailTexts.Insert(0, detailText) textLine = (New CCpfcDetailTextLine).Create(detailTexts) StrstoTextlines.Insert(0, textLine) Next End Function Private Sub ChangeSheets(model1 As IpfcModel, session As IpfcSession, drawing As IpfcDrawing) ' ' Dim session As IpfcBaseSession = Nothing ' Dim conn As IpfcAsyncConnection = Nothing ' Dim model1 As IpfcModel ' Connect(session, conn) ' model1 = session.CurrentModel Dim sheetowner As IpfcSheetOwner = model1 Dim iFormatDrawing As IpfcModelDescriptor Dim DrawingFormat As IpfcDrawingFormat Dim numberofsheets As Integer = sheetowner.NumberOfSheets Dim options As IpfcRetrieveModelOptions = Nothing Dim oModelDescriptor As IpfcModelDescriptor = Nothing Dim oModelDescriptorCreate As New CCpfcModelDescriptor Dim itableowner As IpfcTableOwner = model1 Dim itables As IpfcTables Dim model2d As IpfcModel2D = model1 Dim model2 As IpfcModel = Nothing For v = 1 To numberofsheets ' If TiffCheckBox.Checked = True Then iFormatDrawing = sheetowner.GetSheetFormatDescr(v) Dim oFormat As String = iFormatDrawing.GetFileName Dim sheetname As String = "" Dim regexvalue As String = "" Dim regexvalue2 As String = "" Dim sheetfolder As String = "U:\proe_beallitasok\Creo4\rajzlap\stefani_magyar" regexvalue = "^_ALK_A" regexvalue2 = "^_OA_A" sheetname = sheetowner.GetSheetFormatDescr(v).GetFullName sheetfolder = "U:\proe_beallitasok\Creo4\rajzlap\stefani_magyar" Dim regex As New RegularExpressions.Regex(regexvalue) Dim regex2 As New RegularExpressions.Regex(regexvalue2) ' MsgBox(regexvalue) ' MsgBox(regex.IsMatch(sheetowner.GetSheetFormatDescr(i).GetFullName) & sheetowner.GetSheetFormatDescr(i).GetFullName) drawing.currentsheetnumber = v Dim result As MessageBoxResult = MessageBox.Show("A(z) " & v & " lapszámú rajzlap nem megfelelő formátomú, szeretnéd lecserélni?", "", MessageBoxButton.YesNo, MessageBoxImage.Warning) If result = MessageBoxResult.Yes Then For Each model2view As IpfcView2D In model2d.List2DViews If model2view.GetSheetNumber = v Then model2 = model2view.GetModel Exit For End If Next 'i = 2 iFormatDrawing = sheetowner.GetSheetFormatDescr(v) itables = itableowner.ListTables() For Each itable As IpfcTable In itables If (itable.GetSegmentSheet(0) = v) Then If itable.CheckIfIsFromFormat(v) = True Then itableowner.DeleteTable(itable, Nothing) End If Else ' MsgBox("sdad") End If Next ' MsgBox(sheetname & sheetfolder) oModelDescriptor = oModelDescriptorCreate.Create(EpfcModelType.EpfcMDL_DWG_FORMAT, sheetname, "") options = (New CCpfcRetrieveModelOptions).Create options.AskUserAboutReps = False oModelDescriptor.Path = sheetfolder DrawingFormat = session.RetrieveModelWithOpts(oModelDescriptor, options) sheetowner.SetSheetFormat(i, DrawingFormat, Nothing, model2) MsgBox("Kérlek igazítsd meg a rajzot, majd kattints az OK-ra") End If ' End If Next End Sub Private Sub KulonAloRajzok_Checked(sender As Object, e As RoutedEventArgs) Handles KulonAloRajzok.Checked If KulonAloRajzok.IsChecked = True Then isSeperateDrawing = True Else isSeperateDrawing = False End If End Sub Private Sub Label_MouseDown(sender As Object, e As MouseButtonEventArgs) If e.ChangedButton = MouseButton.Left Then Me.DragMove() End If End Sub Private Sub ExitButton_Click(sender As Object, e As RoutedEventArgs) Environment.Exit(0) End Sub Private Sub AutomaticFolderSelect_Checked(sender As Object, e As RoutedEventArgs) Handles AutomaticFolderSelect.Checked If AutomaticFolderSelect.IsChecked = True Then autofolder = True Else autofolder = False End If End Sub Private Sub BackgroundWorker3_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker3.DoWork Threading.Thread.Sleep(1000) Dim hWndAbout As IntPtr = FindWindowExW(IntPtr.Zero, IntPtr.Zero, Nothing, "Nyomtatás") 'use the dialog window's text in second parameter Dim hWndOkButton As IntPtr = FindWindowExW(hWndAbout, IntPtr.Zero, "Button", "Ok") SendMessageW(hWndOkButton, BM_CLICK, IntPtr.Zero, IntPtr.Zero) SendMessageW(hWndOkButton, BM_CLICK, IntPtr.Zero, IntPtr.Zero) 'some buttons seem to need to receive the message a second time, not sure why??? End Sub Private Sub Progressbar_MouseDoubleClick(sender As Object, e As MouseButtonEventArgs) Handles Progressbar.MouseDoubleClick MainWindow.MinHeight = 370 MainWindow.MaxHeight = 370 End Sub Private Sub PrintExcel(FileNameMod As String) xlApp = New Excel.Application xlWorkBook = xlApp.Workbooks.Open(FileNameMod) xlWorkSheet = xlWorkBook.Worksheets("AUDI-Bemi-Stückliste") xlApp.DisplayAlerts = False xlWorkSheet.PrintOutEx( , , Copies:=1, Preview:=False, Collate:=True, IgnorePrintAreas:=True) End Sub End Class