Files
2025-09-24 16:18:36 +02:00

2103 lines
72 KiB
VB.net
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
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
Try
HandleNames(FileNameMod, y, i, ".xls", Model1)
CreateExcel(Session, FileNameMod)
Catch ex As Exception
End Try
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
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
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 = System.IO.Path.GetFileNameWithoutExtension(model1.FileName)
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
Dim ColCount2 As Integer = TableContent.GetLength(1)
Dim o As Integer = 2
If ColCount2 > 12 Then
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 = 0
xlWorkSheet.Cells(row + u, 3) = TableContent(row, 1) 'gyarto
xlWorkSheet.Cells(row + u, 4) = TableContent(row, 2) 'rajzszan
'xlWorkSheet.Cells(row + u, 3) = TableContent(row, 3)
' xlWorkSheet.Cells(row + u, 3) = TableContent(row, 4)
xlWorkSheet.Cells(row + u, 5) = TableContent(row, 3) 'filename
xlWorkSheet.Cells(row + u, 6) = TableContent(row, 4) 'bf
' xlWorkSheet.Cells(row + u, 5) = TableContent(row, 7) 'ures
xlWorkSheet.Cells(row + u, 8) = TableContent(row, 6) 'db
xlWorkSheet.Cells(row + u, 9) = TableContent(row, 7) 'anyag
' 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, 8) 'fel
xlWorkSheet.Cells(row + u, 12) = TableContent(row, 9) 'felszin
xlWorkSheet.Cells(row + u, 12) = TableContent(row, 10) 'hok
xlWorkSheet.Cells(row + u, 13) = TableContent(row, 11) 'hok kemeny
xlWorkSheet.Cells(row + u, 14) = TableContent(row, 12) 'note
' End If
'
Next
'
Else
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)
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)
' End If
'A fejléc kitöltéseű
xlWorkSheet.Cells(1, 4) = CellToString(table, 1, 4) 'rajszam
xlWorkSheet.Cells(1, 5) = CellToString(table, 1, 5) 'rajszam
xlWorkSheet.Cells(1, 7) = CellToString(table, 1, 7) 'megnevezés
xlWorkSheet.Cells(1, 6) = CellToString(table, 1, 6) 'megnevezés
xlWorkSheet.Cells(1, 10) = CellToString(table, 3, 5) 'tervező
xlWorkSheet.Cells(1, 9) = CellToString(table, 3, 1) 'tervező
xlWorkSheet.Cells(2, 5) = CellToString(table, 2, 5) 'gyártó
xlWorkSheet.Cells(2, 1) = CellToString(table, 2, 1) 'gyártó
xlWorkSheet.Cells(2, 7) = CellToString(table, 2, 7) 'projektszám
xlWorkSheet.Cells(2, 6) = CellToString(table, 2, 6) 'projektszám
xlWorkSheet.Cells(2, 10) = CellToString(table, 3, 7) 'dátum
xlWorkSheet.Cells(2, 9) = CellToString(table, 3, 6) 'dátum
xlWorkSheet.Cells(3, 1) = CellToString(table, 4, 1) 'lsz
xlWorkSheet.Cells(3, 2) = CellToString(table, 4, 2) 'po
xlWorkSheet.Cells(3, 3) = CellToString(table, 4, 3) 'db
xlWorkSheet.Cells(3, 4) = CellToString(table, 4, 4) 'kp
xlWorkSheet.Cells(3, 5) = CellToString(table, 4, 5) 'megnevezes
xlWorkSheet.Cells(3, 6) = CellToString(table, 4, 6) 'rajzszam
xlWorkSheet.Cells(3, 7) = CellToString(table, 4, 7) 'gyarto
xlWorkSheet.Cells(3, 8) = CellToString(table, 4, 8) 'anyagminoseg
xlWorkSheet.Cells(3, 9) = CellToString(table, 4, 9) 'méret
xlWorkSheet.Cells(3, 10) = CellToString(table, 4, 10) 'megjegyzes
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 <Creo Common Files>\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)
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:\Creo11\18-Utilities\Dokumentacio"
Dim ColCount2 As Integer = TableContent.GetLength(1)
Dim sourcePath As String
If ColCount2 > 12 Then
sourcePath = Path.Combine(currentDirectory, "Darabjegyzek_beszerzes.xlsm")
Else
sourcePath = Path.Combine(currentDirectory, "Darabjegyzek.xlsm")
End If
' Generálja a temp fájl elérési útját
' 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
<DllImport("user32.dll", EntryPoint:="FindWindowExW")>
Private Shared Function FindWindowExW(ByVal hWndParent As IntPtr, ByVal hWndChildAfter As IntPtr, <MarshalAs(UnmanagedType.LPWStr)> ByVal lpszClass As String, <MarshalAs(UnmanagedType.LPWStr)> ByVal lpszWindow As String) As IntPtr
End Function
<DllImport("user32.dll", EntryPoint:="SendMessageW")>
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 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)
Dim CellStr2 As String = CellToString(iTablea, 2, 2)
'MsgBox(CellStr)
If CellStr = "Robotizalunk Kft." Or CellStr = "Robotizalunk" Or CellStr2 = "Robotizalunk" Or CellStr2 = "Robotizalunk Kft." 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)
Try
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) = "Robot" 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
Catch ex As Exception
End Try
' 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