Macro to Print all drawings. Ignoring parts and assemblies in reference.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi, I'm Gustavo and i can't get this to work.
I want a macro get the right parts and assemblies. I want to run it into a assembly and print all the drawings, but skipping the parts and assemblies(with his sub-assemblies parts) that is in reference ( BOMStructure = kreference ).
Here's what i have till this moment:
Public Function Print_Idw(oDrgPrintMgr As PrintManager, Impressora As String, Tamanho_Folha)
With oDrgPrintMgr
.Printer = Impressora
.AllColorsAsBlack = True
.ColorMode = kPrintGrayScale
.ScaleMode = kPrintBestFitScale
.PaperSize = Tamanho_Folha
.NumberOfCopies = 1
.Orientation = oDrgPrintMgr.Orientation
'.SubmitPrint
End With
End Function
Public Sub Projeto_VBA_Gustavo()
If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
MsgBox "Este NÃO é um documento de Montagem!", vbExclamation, "Macro Encerrada!"
Exit Sub
End If
Dim Assembly_Doc As AssemblyDocument
Set Assembly_Doc = ThisApplication.ActiveDocument
Dim oDrawDoc As DrawingDocument
Dim Num_Files As Integer
Num_Files = 0
Dim oRefDocs As DocumentsEnumerator
Set oRefDocs = Assembly_Doc.AllReferencedDocuments
Dim oRefDoc As Document
Dim File_System_Object As Object
Set File_System_Object = CreateObject("Scripting.FileSystemObject")
Dim oAsmCompDef As AssemblyComponentDefinition
Set oAsmCompDef = Assembly_Doc.ComponentDefinition
Dim oCompOcc As ComponentOccurrence
Dim Lista_Impressos As Object
Set Lista_Impressos = CreateObject("System.Collections.ArrayList")
Dim Lista_Asm_Referencia As Object
Set Lista_Asm_Referencia = CreateObject("System.Collections.ArrayList")
Dim Lista_Ipt_Referencia As Object
Set Lista_Ipt_Referencia = CreateObject("System.Collections.ArrayList")
For Each oRefDoc In oRefDocs
Folder_split = Split(oRefDoc.FullFileName, "\")
N_De_Splits = UBound(Folder_split)
oRefDoc_File_Name = Left(Folder_split(N_De_Splits), Len(Folder_split(N_De_Splits)) - 4)
If Len(oRefDoc_File_Name) >= 6 Then
For Each oCompOcc In oAsmCompDef.Occurrences.AllReferencedOccurrences(oRefDoc)
If oCompOcc.BOMStructure = BOMStructureEnum.kReferenceBOMStructure Then
If oCompOcc.DefinitionDocumentType = kAssemblyDocumentObject And _
Not Lista_Asm_Referencia.Contains(oRefDoc.FullDocumentName) Then Lista_Asm_Referencia.Add oRefDoc.FullDocumentName
If oCompOcc.DefinitionDocumentType = kPartDocumentObject And _
Not Lista_Ipt_Referencia.Contains(oRefDoc.FullDocumentName) Then Lista_Ipt_Referencia.Add oRefDoc.FullDocumentName
Else
If oCompOcc.DefinitionDocumentType = kAssemblyDocumentObject And _
Lista_Asm_Referencia.Contains(oRefDoc.ReferencingDocuments(1).FullDocumentName) Then Lista_Asm_Referencia.Add oRefDoc.FullDocumentName
If oCompOcc.DefinitionDocumentType = kPartDocumentObject And _
Not Lista_Ipt_Referencia.Contains(oRefDoc.FullDocumentName) And _
Not Lista_Asm_Referencia.Contains(oRefDoc.ReferencingDocuments(1).FullDocumentName) And _
Not Lista_Impressos.Contains(oRefDoc.FullDocumentName) Then Lista_Impressos.Add oRefDoc.FullDocumentName
If oCompOcc.DefinitionDocumentType = kAssemblyDocumentObject And _
Not Lista_Asm_Referencia.Contains(oRefDoc.ReferencingDocuments(1).FullDocumentName) And _
Not Lista_Impressos.Contains(oRefDoc.FullDocumentName) Then Lista_Impressos.Add (oRefDoc.FullDocumentName)
End If
Next
End If
Next
Dim i As Long
Debug.Print vbLf & vbLf & "----------> REFERENCE ASSEMBLIES <-----------" & vbLf
For i = 0 To Lista_Asm_Referencia.Count - 1
Debug.Print Lista_Asm_Referencia.Item(i)
Next i
Debug.Print vbLf & vbLf & "----------> REFERENCE PARTS <-----------" & vbLf
For i = 0 To Lista_Ipt_Referencia.Count - 1
Debug.Print Lista_Ipt_Referencia.Item(i)
Next i
Debug.Print vbLf & vbLf & "----------> PARTS/ASSEMBLIES TO PRINT <-----------" & vbLf
Lista_Impressos.Sort
For i = 0 To Lista_Impressos.Count - 1
Debug.Print Lista_Impressos.Item(i)
Next i
If MsgBox("Serão impressos " & Lista_Impressos.Count & " arquivos. Após início NÃO há volta!" & vbLf & _
"Deseja continuar com a impressão? ", vbYesNo + vbExclamation, "Impressão de arquivos .idw") = vbNo Then Exit Sub
Lista_Impressos.Sort
Debug.Print vbLf & vbLf & "ARQUIVOS QUE SERÃO IMPRESSOS: " & vbLf
For i = 0 To Lista_Impressos.Count - 1
Folder_split = Split(Lista_Impressos(i), "\")
N_De_Splits = UBound(Folder_split)
oRefDoc_File_Name = Left(Folder_split(N_De_Splits), Len(Folder_split(N_De_Splits)) - 4)
idwPathName = Left(Lista_Impressos(i), Len(Lista_Impressos(i)) - 4) & ".idw"
Debug.Print oRefDoc_File_Name
If File_System_Object.FileExists(idwPathName) = True Then
Set oDrawDoc = ThisApplication.Documents.Open(idwPathName, True)
oDrawDoc.Activate
Idw_Paper_Size = oDrawDoc.ActiveSheet.Border.Name
If Idw_Paper_Size = "A4" Or Idw_Paper_Size = "A3" Then
Print_Idw oDrawDoc.PrintManager, "IMPRESSORA ENGENHARIA", 14341
Else
If Idw_Paper_Size = "A2" Then papel = 14339
If Idw_Paper_Size = "A1" Then papel = 14359
If Idw_Paper_Size = "A0" Then papel = 14357
If MsgBox("Desenho em Folha " & Idw_Paper_Size & "." & vbLf & "Deseja imprimir?", _
vbYesNo + vbQuestion, "Imprimir na Plotter") = vbYes Then _
Print_Idw oDrawDoc.PrintManager, "PLOTTER", papel
End If
oDrawDoc.Close (True)
End If
Next i
MsgBox "Total de " & Lista_Impressos.Count & " arquivos impressos!"
End Sub