Macro to Print all drawings. Ignoring parts and assemblies in reference.

gustavo.cassel
Advocate

Macro to Print all drawings. Ignoring parts and assemblies in reference.

gustavo.cassel
Advocate
Advocate

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

0 Likes
Reply
333 Views
2 Replies
Replies (2)

Ralf_Krieg
Advisor
Advisor

Hello

 

Can you tell us in detail where you get stuck? A first short test creates the drawing list as I would expect it. I've not tested printing sub itself.


R. Krieg
RKW Solutions
www.rkw-solutions.com
0 Likes

gustavo.cassel
Advocate
Advocate

Hello!!

After a couple days of testing i realize that the error was on the method that i choose to list the parts and assemblies that need to be printed. In my case, i changed the code to read the structured view of the BOM and i get what i want. In summary, i needed a code that filter the parts and assemblies that have a name >= 6 digits, and ignore all the BOM kreference parts and assemblies.

Here's the code now and now he is picking the rights parts and assemblies.

 

Public Sub Bill_of_Materials_Scan(oBOMRows As BOMRowsEnumerator, List_Print, List_Check, List_Qtdy)
Dim oBOMRow As BOMRow
For Each oBOMRow In oBOMRows
Dim oDef As ComponentDefinition
Set oDef = oBOMRow.ComponentDefinitions(1)
Nome_do_Arquivo oDef.Document.FullFileName, oRefDoc_File_Name
If Len(oRefDoc_File_Name) >= 6 Then
If Not List_Print.Contains(oDef.Document.FullFileName) Then List_Print.Add oDef.Document.FullFileName
If Not List_Check.Contains(oRefDoc_File_Name) Then List_Check.Add oRefDoc_File_Name
End If
If Not oBOMRow.ChildRows Is Nothing Then Call Bill_of_Materials_Scan(oBOMRow.ChildRows, List_Print, List_Check, List_Qtdy)
Next
End Sub


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


Function Nome_do_Arquivo(Path, Doc_Name)
Folder_split = Split(Path, "\")
N_De_Splits = UBound(Folder_split)
Doc_Name = Left(Folder_split(N_De_Splits), Len(Folder_split(N_De_Splits)) - 4)
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 oAsm As AssemblyDocument
Set oAsm = ThisApplication.ActiveDocument
Dim oBOM As BOM
Set oBOM = oAsm.ComponentDefinition.BOM
oBOM.StructuredViewEnabled = True
oBOM.StructuredViewFirstLevelOnly = False
Dim oBOMView As BOMView
Set oBOMView = oBOM.BOMViews("Estruturada")
Dim List_to_Print As Object
Set List_to_Print = CreateObject("System.Collections.ArrayList")
Dim List_to_Check As Object
Set List_to_Check = CreateObject("System.Collections.ArrayList")
Dim File_System_Object As Object
Set File_System_Object = CreateObject("Scripting.FileSystemObject")

Call Bill_of_Materials_Scan(oBOMView.BOMRows, List_to_Print, List_to_Check, List_Quantity)


If MsgBox("Serão impressos " & List_to_Print.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

 

List_to_Print.Sort
For i = 0 To List_to_Print.Count - 1
idwPathName = Left(List_to_Print(i), Len(List_to_Print(i)) - 4) & ".idw"
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 " & List_to_Print.Count & " arquivos impressos!"

End Sub

 

 

Thank you for reply me! Now im gonna go next and now i need to find the quantity of each part and assembly!

0 Likes