' - - - - - - - - - - - - - - VYTVO�ENO 2021-08-17 - - - - - - - - - - - - - -


'definovat aktivn� dokument jako soubor sestavy.'
Dim oAsmDoc As AssemblyDocument
oAsmDoc = ThisApplication.ActiveDocument
oAsmName = Left(oAsmDoc.DisplayName, Len(oAsmDoc.DisplayName))

'zkontrolujte, zda je aktivn� dokument soubor sestavy.'
If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
MessageBox.Show("Please run this rule from the assembly file.", "iLogic")
Exit Sub
End If

'z�skat vstup u�ivatele
RUsure = MessageBox.Show ( _
"T�m se vytvo�� soubor PDF pro v�echny sou��sti sestavy, kter� maj� soubory v�kres�." _
& vbLf & "Toto pravidlo o�ek�v�, �e v�kresov� soubor bude m�t stejn� n�zev a um�st�n� jako sou��st." _
& vbLf & " " _
& vbLf & "Opravdu chcete vytvo�it v�kresy PDF pro v�echny sou��sti sestavy?" _
& vbLf & "To m��e chv�li trvat." , "ILogic   - d�vkov� v�stup soubory PDF ",MessageBoxButtons.YesNo)

If RUsure = vbNo Then
Return
Else
End If

' - - - - - - - - - - - - - - Nastaven� PDF - - - - - - - - - - - - - -
oPath = ThisDoc.Path
PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

If PDFAddIn.HasSaveCopyAsOptions(oDataMedium, oContext, oOptions) Then
oOptions.Value("All_Color_AS_Black") = 0
oOptions.Value("Remove_Line_Weights") = 0
oOptions.Value("Vector_Resolution") = 400
oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintAllSheets
oOptions.Value("Custom_Begin_Sheet") = 1
oOptions.Value("Custom_End_Sheet") = 4
End If

'z�skat cestu k c�lov� slo�ce PDF
oFolder = oPath & "\EXPORT\" & oAsmName & "- V�kresy"

'Vyhledejte slo�ku PDF a vytvo�te ji, pokud neexistuje
If Not System.IO.Directory.Exists(oFolder) Then
    System.IO.Directory.CreateDirectory(oFolder)
End If

'z�skat cestu k c�lov� podslo�ce Form�t� PDF
oFolder_A4 = oFolder & "\" & oAsmName & "- V�kresy _Format A4"
oFolder_A3 = oFolder & "\" & oAsmName & "- V�kresy _Format A3"

'Vyhledejte podslo�ce Form�t� PDF a vytvo�te ji, pokud neexistuje
If Not System.IO.Directory.Exists(oFolder_A4) Then
    System.IO.Directory.CreateDirectory(oFolder_A4)
End If

If Not System.IO.Directory.Exists(oFolder_A3) Then
    System.IO.Directory.CreateDirectory(oFolder_A3)
End If
'
'MessageBox.Show("Nov� spodslo�ky vytvo�en� : " & vbLf & oFolder_A4 & vbLf & oFolder_A3, "iLogic")

' - - - - - - - - - - - - - - -
'
' - - - - - - - - - - - - - - V�kresy sou��st� - - - - - - - - - - - - - -

'pod�vejte se na soubory, na kter� odkazuje shrom�d�n�.'
Dim oRefDocs As DocumentsEnumerator
oRefDocs = oAsmDoc.AllReferencedDocuments
Dim oRefDoc As Document

'pracujte s v�kresov�mi soubory pro odkazovan� modely
'toto o�ek�v�, �e model bude m�t kresbu se stejnou cestou a n�zvem
For Each oRefDoc In oRefDocs
idwPathName = Left(oRefDoc.FullDocumentName, Len(oRefDoc.FullDocumentName)-3) & "idw"

If(System.IO.File.Exists(idwPathName)) Then
                        Dim oDrawDoc As DrawingDocument
                        
               oDrawDoc = ThisApplication.Documents.Open(idwPathName, False)               
            oFileName = Left(oRefDoc.DisplayName, Len(oRefDoc.DisplayName))

                p = Parameter(oFileName &":1", "FORMAT")
                If p = "A3" Then
                oFolderV = oFolder_A3
                Else
                oFolderV = oFolder_A4
                End If
                

                
            On Error Resume Next ', pokud soubor PDF existuje a je otev�en� nebo pouze pro �ten�, pokra�ujte d�le
            
                 'Nastavte n�zev c�lov�ho souboru PDF
                oDataMedium.FileName = oFolderV & "\" & oFileName & ".pdf"
                'aktualizuje
                oDrawDoc.StylesManager.Layers().Visible = False
                oDrawDoc.StylesManager.Layers().Visible = True

                iLogicVb.UpdateWhenDone = True
                'Napi�te PDF
                Call PDFAddIn.SaveCopyAs(oDrawDoc, oContext, oOptions, oDataMedium)
            'zav�i soubor
                oDrawDoc.Close
Else
'Pokud model nem� v�kres se stejnou cestou a n�zvem - ned�lejte nic
End If

Next
' - - - - - - - - - - - - - - -

' - - - - - - - - - - - - - - V�kres nejvy��� �rovn� - - - - - - - - - - - - - -


oAsmDrawing = ThisDoc.ChangeExtension(".idw")
oAsmDrawingDoc = ThisApplication.Documents.Open(oAsmDrawing, True)
oAsmDrawingName = Left(oAsmDrawingDoc.DisplayName, Len(oAsmDrawingDoc.DisplayName))
'vypi�te PDF pro soubor v�kresu sestavy nejvy��� �rovn�
On Error Resume Next  ', pokud soubor PDF existuje a je otev�en� nebo pouze pro �ten�, pokra�ujte d�le
 'Nastavte n�zev c�lov�ho souboru PDF
 
                 p = Parameter.Param( "FORMAT")
                If p = "A3" Then
                oFolderVS = oFolder_A3
                Else
                oFolderVS = oFolder_A4
                End If
 
oDataMedium.FileName = oFolderVS & "\" & oAsmDrawingName & ".pdf"
'Napi�te PDF
Call PDFAddIn.SaveCopyAs(oAsmDrawingDoc, oContext, oOptions, oDataMedium)
'Zav�ete v�kres nejvy��� �rovn�
oAsmDrawingDoc.Close
'- - - - - - - - - - - - -
'
'MessageBox.Show("Nov� soubory vytvo�en� v: " & vbLf & oFolder, "iLogic")
''otev�ete slo�ku, kam jsou ulo�eny nov� soubory 

Připojené náhledy