Charlesúv blog: 2016-03

Here is my macro for print all drawings for components for opened drawing. The condition is the same name model and drawing. But this condition can be changed. I tested the macro only on Inventor version 2016.

Function TiskVykresu(CestaVykresu As String, Zavrit As Boolean)
'Funkce pro tisk výkresu podle jeho velikosti
Dim oDrgDoc As Inventor.Document
Dim JmenoDokumentu As String
ThisApplication.SilentOperation = True
Set oDrgDoc = ThisApplication.Documents.Open(CestaVykresu)
JmenoDokumentu = oDrgDoc.DisplayName
Dim oDrgPrintMgr As DrawingPrintManager
Set oDrgPrintMgr = oDrgDoc.PrintManager
Dim JmenoAktualnihoListu As String
Dim JmenaListu As String
Dim PocetListu As Long
PocetListu = oDrgDoc.Sheets.Count
'Zjištění velikosti aktivního listu
Dim VelikostListu As String
Dim VelikostTisku As String
oDrgPrintMgr.Printer = "\\VFS01\prt_16_chodba_prizemi_primy" 'Nastavit podle svojí tiskárny
oDrgPrintMgr.PaperSize = kPaperSizeA3 'Přednastavení
VelikostTisku = "A3" 'Přednastavení
oDrgPrintMgr.AllColorsAsBlack = True

oDrgPrintMgr.NumberOfCopies = 1

oDrgPrintMgr.PrintRange = kPrintAllSheets
oDrgPrintMgr.Orientation = kPortraitOrientation
Select Case oDrgDoc.Sheets.Item(1).Size
Case kA0DrawingSheetSize
VelikostListu = "A0"
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
  Case kA1DrawingSheetSize
VelikostListu = "A1"
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
  Case kA2DrawingSheetSize
VelikostListu = "A2"
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
  Case kA3DrawingSheetSize
VelikostListu = "A3"
oDrgPrintMgr.PaperSize = kPaperSizeA3 'Nastavení papíru tiskárny
VelikostTisku = "A3"
oDrgPrintMgr.ScaleMode = kPrintFullScale
  Case kA4DrawingSheetSize
VelikostListu = "A4"
oDrgPrintMgr.PaperSize = kPaperSizeA4 'Nastavení papíru tiskárny
VelikostTisku = "A4"
oDrgPrintMgr.ScaleMode = kPrintFullScale
  Case Else
VelikostListu = "nestandartní"
End Select
' Zjištění natočení listu a případná změna
Dim OtoceniListu As String
If oDrgDoc.ActiveSheet.Orientation = kPortraitPageOrientation Then
oDrgPrintMgr.Rotate90Degrees = 0
OtoceniListu = "na výšku"
Else
oDrgPrintMgr.Rotate90Degrees = 1
OtoceniListu = "na šířku"
End If
JmenoAktualnihoListu = oDrgDoc.ActiveSheet.Name
Dim CisloAktivnihoListu As Long
Dim i As Variant
'Zjištění čísla aktivního listu
For i = 1 To PocetListu
JmenaListu = oDrgDoc.Sheets.Item(i).Name
If JmenoAktualnihoListu = JmenaListu Then
CisloAktivnihoListu = i
End If
Next
If Zavrit = True Then
oDrgDoc.Close
End If
ThisApplication.SilentOperation = False
End Function

Sub Prehled_DoplnujicichVykresu()
'Makro pro nalezení zúčastněných modelú a jejich výkresú
Dim VykesSestavy As Inventor.DrawingDocument
Dim Dil As Inventor.Document
Dim Cesta As String
Dim Jmeno As String
Dim SeznamVykr As String
Set VykesSestavy = ThisApplication.ActiveDocument
PocetDilu = VykesSestavy.AllReferencedDocuments.Count
Dim PocetVykresu As Integer
PocetVykresu = 0
Dim i As Integer
i = 1
For Each Dil In VykesSestavy.AllReferencedDocuments 'Opakuje pro každý díl vstupující do výkresu
Set Dil = VykesSestavy.AllReferencedDocuments.Item(i) 'Načtení dílu
Jmeno = Dil.DisplayName
Cesta = Left(Dil.FullDocumentName, Len(Dil.FullDocumentName) - Len(Jmeno)) 'Cseta k soubouru bez jeho názvu
Jmeno = Left(Jmeno, 4) + ".idw" 'Doplnění přípony výkreesu inventoru
Cesta = Cesta + Jmeno 'Celá cesta k výkresu
If Dir$(Cesta) <> "" Then 'Finta jak zjistit jestli soubor existuje
SeznamVykr = SeznamVykr + Chr(10) + Jmeno
If i = 1 Then
Call TiskVykresu(Cesta, False)
Else
Call TiskVykresu(Cesta, True)
End If
PocetVykresu = PocetVykresu + 1 'Připočtení výkresu pokud existuje
End If
i = i + 1
Next 'Konec načítání jednotlivých dílú výkresu
MsgBox ("Počet dílú: " & PocetDilu & Chr(10) & "z toho výkresú: " & PocetVykresu & Chr(10) & SeznamVykr) 'Info co jsme vyčetli o souborech výkresu
End Sub

Charlesúv blog

Presentation of my macro for assembly drawings

Golden fish

Autodesk Inventor macro for Print all drawings