Open all drawing save as PDF and fail before drawing nr 61 of 267 and get this Error. Any idear why and is there a way to fix it ?
Sub Main()
'Delete all files in folder
Dim Time As DateTime = DateTime.Now
Dim Format As String = "dd-MM-yyyy"
oPath = "H:\2e. Tegnestue\10. Drawing Review" & "\" & iProperties.Value("Project", "Part Number") & "\" 'ThisDoc.Path
'check if it is not there
'Check if folder is there
Dim oFolder As String
oFolder = "H:\2e. Tegnestue\10. Drawing Review" & "\" & iProperties.Value("Project", "Part Number")
'create new folder
If System.IO.Directory.Exists(oFolder) = False Then
System.IO.Directory.CreateDirectory(oFolder)
Else
End If
'are you running on the same file as last time ?
Dim Filenavn As Boolean
'what is done or not finish ?
Dim Status As Boolean
'was is an PDF printing or Mission drawing analysning ?
Dim Logtype As Boolean
Dim msg As String
msg = ("" & vbLf & "Part Numner: "+iProperties.Value("Project", "Part Number")& vbLf & "Description: "+iProperties.Value("Project", "Description")& vbLf & "Title: "+ iProperties.Value("Summary", "Title")& vbLf).ToString
Dim doc = ThisDoc.Document
Dim sDocumentSubType As String = doc.SubType
'Undersøger Document type"
If sDocumentSubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Or sDocumentSubType = "{4D29B490-49B2-11D0-93C3-7E0706000000}" Then ' = "Sheet Metal" Or "Part"
PDFFormIpt()
End If
'Slet Log
If sDocumentSubType = "{BBF9FDF1-52DC-11D0-8C04-0800090BE8EC}" Then ' = "Idw"
iLogicVb.RunExternalRule("SavePDF")
'Document type Part
End If
If sDocumentSubType = "{E60F81E1-49B3-11D0-93C3-7E0706000000}" Or sDocumentSubType = "{28EC8354-9024-440F-A8A2-0E0E55D635B0}" Then ' = "assembly"
'Delete local copy
Try
oLocalPath = "C:\K-Tools\TempReviewPDF"
Dim FileList As String() = System.IO.Directory.GetFiles(oLocalPath , "*.*")
For Each f As String In FileList
'MsgBox("Want to delete " & f)
System.IO.File.Delete(f)
Next
Catch
End Try
Try
Dim FileList As String() = System.IO.Directory.GetFiles(oPath, "*.*")
For Each f As String In FileList
'MsgBox("Want to delete " & f)
System.IO.File.Delete(f)
Next
Catch' dirNotFound As DirectoryNotFoundException
'MsgBox(dirNotFound.Message)
End Try
PDFAssambly()
End If
SendMail(oFolder)
End Sub
Sub PDFFormIpt()
NewFileName = ThisDoc.ChangeExtension(".idw")
'open the indexed file, false opens the file without generating the graphics
Dim oDrawDoc
Try
oDrawDoc = ThisApplication.Documents.Open(NewFileName, True)
Catch ex As Exception
MsgBox(ex.Message)
Exit Sub
End Try
Dim auto = iLogicVb.Automation
Try
auto.RunExternalRule(oDrawDoc, "SavePDFForReview")
Catch ex As Exception
MsgBox(ex.Message)
Exit Sub
End Try
oRevNum = iProperties.Value("Project", "Revision Number")
Try
source = "C:\K-Tools\TempReviewPDF\" & iProperties.Value("Project", "Part Number") & " R" & oRevNum & ".pdf"
Catch
MsgBox("Error in Source")
Exit Sub
End Try
oPath = "H:\2e. Tegnestue\10. Drawing Review" & "\" & iProperties.Value("Project", "Part Number") & "\"
Try
destfile = oPath & iProperties.Value("Project", "Part Number") & " R" & oRevNum & ".pdf"
Catch
MsgBox("Error it destfile")
Exit Sub
End Try
Try
System.IO.File.Copy(source, destfile, True)
Catch ex As Exception
MsgBox(ex.Message)
Exit Sub
End Try
Try
Dim Templete
Dim CopyOf
Templete = "H:\2e. Tegnestue\3. Konstruktionshjælp - standarder, federtabel, pasninger, mv\Kontrollister\2D Check liste.docx"
CopyOf = oPath & "\" & "2D Check liste.docx"
System.IO.File.Copy(Templete, CopyOf, True)
Catch
End Try
End Sub
Sub PDFAssambly()
myparam = InputBox("Prompt", "Title", "DD-MM-YYYY")
oDate3 = New DateTime(Right(myparam, 4), Mid(myparam, 4, 2), Left(myparam, 2), 0, 0, 1)
' Check that the active document is an assembly file
If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
MessageBox.Show("Please run this rule from the assembly file.", "iLogic")
Exit Sub
End If
' Define the active document As an Assembly file
Dim oAsmDoc As AssemblyDocument
oAsmDoc = ThisApplication.ActiveDocument
Dim oAsmName As String
oAsmName = Left(oAsmDoc.DisplayName, Len(oAsmDoc.DisplayName) -4)
'- - - - - - - - - - - - -Component Drawings - - - - - - - - - - - -
' Look at the files referenced by the assembly
Dim oRefDocs As DocumentsEnumerator
oRefDocs = oAsmDoc.AllReferencedDocuments
Dim oRefDoc As Document
' Work the the drawing files for the referenced models
' This expects that the model has a drawing of the same path and name
'Make Log
' Look at the files referenced by the assembly
oRefDocs = oAsmDoc.AllReferencedDocuments
For Each oRefDoc In oRefDocs
Try
Logger.Info(" Start Printing PDF")
Try
Logger.Info(iProperties.Value(oRefDoc.DisplayName, "Project", "Part Number"))
Catch
End Try
Logger.Info("line 208")
idwPathName = Left(oRefDoc.FullDocumentName, Len(oRefDoc.FullDocumentName) -3) & "idw"
Logger.Info(idwPathName.ToString & " " & "NewDrawning")
' Check to see that the model has a drawing of the same path and name
Dim oDrawDoc As DrawingDocument
'False Grafik off True Grafik on
Try
Logger.Info(" Open Drawing ")
Logger.Info("line 221")
If (System.IO.File.Exists(idwPathName)) Then
oDrawDoc = ThisApplication.Documents.Open(idwPathName, False)
Logger.Info("line 224")
End If
Catch
Try
Catch
oRefDoc.DisplayName=""
Try
Catch
End Try
Logger.Info("wrong displaynName " & idwPathName.ToString)
End Try
End Try
If (System.IO.File.Exists(idwPathName)) Then
Dim oFS As Object
Dim oDate1 As DateTime
Logger.Info("line 247")
oFS = CreateObject("Scripting.FileSystemObject")
'Dato for hvornår den sidste er blevet ændret
oDate1 = oFS.GetFile(idwPathName).DateLastModified
If oDate1.CompareTo(oDate3) >= 0 Then
ThisApplication.Documents.Open(idwPathName, True)
Dim strFileName As String
Dim auto = iLogicVb.Automation
Logger.Info("Run Code on Drawing")
Logger.Info("line 258")
auto.RunExternalRule(oDrawDoc, "SavePDFForReview")
'Start code
Try
oRevNum = iProperties.Value(oRefDoc.DisplayName, "Project", "Revision Number")
Try
source = "C:\K-Tools\TempReviewPDF\" & iProperties.Value(oRefDoc.DisplayName, "Project", "Part Number") & " R" & oRevNum & ".pdf"
Catch
MsgBox("Error in Source")
Exit Sub
End Try
oPath = "H:\2e. Tegnestue\10. Drawing Review" & "\" & iProperties.Value("Project", "Part Number") & "\"
Try
destfile = oPath & iProperties.Value(oRefDoc.DisplayName, "Project", "Part Number") & " R" & oRevNum & ".pdf"
Catch
MsgBox("Error it destfile")
Exit Sub
End Try
Try
System.IO.File.Copy(source, destfile, True)
Catch ex As Exception
MsgBox(ex.Message)
Exit Sub
End Try
Catch
End Try
End If
Logger.Info(" Close Drawing")
oDrawDoc.Close(True)
End If
Logger.Info(" Start on Next Drawing")
Catch
End Try
Next
PDFFormIpt()
Logger.Info("Printing Done")
Logger.Info("Open Excel 6")
Dim Copyto
Copyto = "H:\2e. Tegnestue\10. Drawing Review" & "\" & iProperties.Value("Project", "Part Number")
Dim copyfrom
copyform = "C:\K-Tools\TempReviewPDF\"
Try
Dim FileList As String() = System.IO.Directory.GetFiles("C:\K-Tools\TempReviewPDF" , "*.*")
For Each f As String In FileList
'"Want to delete f)
System.IO.File.Delete("H:\2e. Tegnestue\10. Drawing Review" & "\" & iProperties.Value("Project", "Part Number")+"\"+ Right(f,Len(f)-25))
System.IO.File.Copy(f,"H:\2e. Tegnestue\10. Drawing Review" & "\" & iProperties.Value("Project", "Part Number")+"\"+ Right(f,Len(f)-25))
Logger.Info(" Form " +f + " To " +"H:\2e. Tegnestue\10. Drawing Review" & "\" & iProperties.Value("Project", "Part Number")+"\"+ Right(f,Len(f)-25))
Next
Catch
Logger.Info("Fail to copy", filename)
End Try
Dim Proc As String = "Explorer.exe"
Dim Args As String = "H:\2e. Tegnestue\10. Drawing Review" & "\" & iProperties.Value("Project", "Part Number") & "\"
Process.Start(Proc, Args)
End Sub
Sub SendMail(txt)
oOApp = CreateObject("Outlook.Application")
oOMail = oOApp.CreateItem(0)
oOCompany = ""
oOSagnsopgavenummer = ""
oOReviewLink = txt '"H:\2e. Tegnestue\10. Drawing Review\2160133000527"
StockNum="test1" 'iProperties.Value("Project", "Stock Number")
PartName=iProperties.Value("Project", "Part Number") 'iProperties.Value("Summary", "Title")
question = MessageBox.Show("Skal CTO finde en til 2d review", "Send Mail til CTO?",MessageBoxButtons.YesNo)
If question = vbYes Then
'MsgBox("Sending Mail")
oOCompany = InputBox("Prompt", "Skriv Kundenavn", "Kunde")
oOSagnsopgavenummer = InputBox("Prompt", "Skriv Sagsnr-Sagsopgave nummer", "Sagsnr-Sagsopgave nummer")
Else If question = vbNo Then
Exit Sub
End If
strbody = "<p style='font-family:calibri;font-size:16'>" & "Hej Kasper" & "<br><br>" & vbNewLine & vbNewLine & _
"Kan du finde en til at lave 2d review på" & vbNewLine & "<br>" & iProperties.Value("Project", "Part Number") & vbNewLine & "<br>" & iProperties.Value("Project", "Description") & vbNewLine & "<br>" & oOCompany & vbNewLine & "<br>" & oOSagnsopgavenummer & "<br><br>" & vbNewLine & vbNewLine & "<a href="& oOReviewLink.Replace(" ","%20") & ">" & oOReviewLink & "</a>" & "</P>"
'& " - " +
With oOMail
.bodyformat=2
.To = "[email protected]" ' The automatic send only works if a mailadress is set here
.CC = ""
.BCC = ""
.Subject = "2d review af " & iProperties.Value("Project", "Description")& "- " & "til " & oOCompany' PartName
''''' part that is missing
. Display
End With
With oOMail
'''''
.HTMLbody = strbody & vbNewLine '& .HTMLBody ' add the signature without losing the HTML-formatting of the signature
'.Attachments.Add ("C:\Test.jpg")
'.Display 'To pop up the Mail just remove'
.Send 'If you don't want to send automatic set '
End With
End Sub
second code SavePDFFor Review
Imports System.Windows.Forms
Dim Time As DateTime = DateTime.Now
Dim Format As String = "dd-MM-yyyy"
oPath = "C:\K-Tools\TempReviewPDF" & "\" 'ThisDoc.Path
oFileName = ThisDoc.FileName(False) 'without extension
'oRevNum = iProperties.Value("Project", "Revision Number")
'new code
Dim oDrawDoc As DrawingDocument = ThisDoc.Document
Dim oRefedDoc As Document = oDrawDoc.ReferencedDocuments.Item(1)
Dim oProp As Inventor.Property = oRefedDoc.PropertySets("{F29F85E0-4FF9-1068-AB91-08002B27B3D9}").Item("Revision Number")
oRevNum = oProp.Value
'end code
'MsgBox(oRevNum)
oPDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
oDocument = ThisApplication.ActiveDocument
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
'oOptions.Value("All_Color_AS_Black") = 0
'oOptions.Value("Remove_Line_Weights") = 1
'oOptions.Value("Vector_Resolution") = 400
oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintAllSheets
'oOptions.Value("Custom_Begin_Sheet") = 2
'oOptions.Value("Custom_End_Sheet") = 4
'get PDF target folder path
oFolder = Left(oPath, InStrRev(oPath, "\")) '& "TempDraftPDF"
'Check for the PDF folder and create it if it does not exist
If Not System.IO.Directory.Exists(oFolder) Then
System.IO.Directory.CreateDirectory(oFolder)
End If
'Set the PDF target file name
oDataMedium.FileName = oFolder & "\" & oFileName & _
" R" & oRevNum & ".pdf"
'Publish document
oPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
