Code to print all layouts in all files in a folder

[jaconbue]

I've just finished to develop a code to print all layouts in all cad drawing files existing in a specified folder, with some user entered options (printer, paper size, plot style).

 

SCHEMA

First, a dos batch script to load AutoCAD, open a special CAD drawing and load a SCR (AutoCAD Script File).

Second, the AutoCAD Script File loads a Visual Basic Macro inside the file.

Third, the Macro ask the user to enter some information, opens all files within a folder, and plots all layouts inside the files, with the user entered options.

When it finishes, it closes all files, and SCR closes AutoCAD.

 

DOS BATCH SCRIPT [iMPRIMELOTE.BAT]

 @echo off
break on
cls
title     Impresi¢n por lotes en AutoCAD
echo.
echo.
echo     Iniciando AutoCAD...
echo.
echo.
if exist "%programfiles%\Autocad 2004\acad.exe" set CAD="%programfiles%\Autocad 2004\acad.exe"
if exist "%programfiles%\Autocad 2005\acad.exe" set CAD="%programfiles%\Autocad 2005\acad.exe"
if exist "%programfiles%\Autocad 2006\acad.exe" set CAD="%programfiles%\Autocad 2006\acad.exe"
%CAD% %~dps0ImprimeLote.dwg /b %~dps0ImprimeLote.scr
exit

AUTOCAD SCRIPT [iMPRIMELOTE.SCR]

_-vbarun Módulo1.ImprimeLote  
_qsave  
_quit 

VISUAL BASIC MACRO [MÓDULO1.IMPRIMELOTE]

Public Sub ImprimeLote()
Dim numPresentaciones As Integer
Dim numArchivos As Integer
Dim respuesta As Variant
Dim Impresora As String
Dim Papel As String
Dim Ancho As Double
Dim AnchoPredet As Double, AltoPredet As Double
Dim Escala As Double
Escala = 1
Dim n As Double, d As Double
Dim Plumilla As String
Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")

numArchivos = Application.Documents.Count

'Introduzco datos
respuesta = InputBox("Introduzca la ruta de la carpeta" & Chr(10) & _
   "(completa, incluyendo letra de unidad)", "Impresión por lotes")
If respuesta  "" Then
   If fs.folderexists(Carpeta) Then
       Carpeta = respuesta
   Else

       MsgBox "Error: No existe la carpeta", vbApplicationModal, "Impresión por lotes"         End
   End If
Else
   End
End If
respuesta = InputBox("Introduzca el nombre de la impresora" & Chr(10) & _
   "(debe coincidir con el nombre guardado en AutoCAD)", "Impresión por 
lotes") If respuesta  "" Then
   Impresora = respuesta
Else
   End
End If
respuesta = InputBox("Introduzca el tamaño del papel" & Chr(10) & _
   "(debe coincidir con el de AutoCAD, por ejemplo ISO A3)", "Impresión por lotes")
If respuesta  "" Then
   Papel = respuesta
Else
   End
End If
respuesta = InputBox("Introduzca el ancho del papel" & Chr(10) & _
   "(en mm, servirá para ajustar la escala de impresión)", "Impresión por lotes")
If respuesta  "" Then
   Ancho = respuesta
Else
   End
End If
respuesta = InputBox("Introduzca el nombre de la plumilla" & Chr(10) & _
   "(archivo CTB para configurar la impresión)" & Chr(10) & _
   "[.] para ninguna." & Chr(10) & _
   "[en blanco] para usar la predeterminada.", "Impresión por lotes")
If respuesta  "" Then
   Plumilla = respuesta
Else
   'End Si el usuario lo deja en blanco, se usará el valor por defecto
End If

' creo la lista de archivos
Set f = fs.GetFolder(Carpeta)
Set fc = f.Files
For Each f1 In fc
   If Right(f1.Name, 3) = "dwg" Or Right(f1.Name, 3) = "DWG" Then
       ' abre el archivo
       Application.Documents.Open f1.Path
       
       ' extrae cuántas presentaciones hay
       numPresentaciones = Application.ActiveDocument.Layouts.Count
       
       ' voy activando presentaciones y las imprimo
       For i = 0 To numPresentaciones - 1
           If Application.ActiveDocument.Layouts.Item(i).Name  "Model" Then 'No imprimimos el modelo
               'activo la presentación
               Application.ActiveDocument.SendCommand ("_layout" & vbCr & 
"_s" & vbCr & Application.ActiveDocument.Layouts.Item(i).Name & vbCr)
               'fijo la escala
               Application.ActiveDocument.Layouts.Item(i).GetCustomScale n, d
               Escala = n / d
               Application.ActiveDocument.Layouts.Item(i).GetPaperSize 
AnchoPredet, AltoPredet                 If AnchoPredet >= AltoPredet Then
                   respuesta = AnchoPredet
               Else
                   respuesta = AltoPredet
               End If
               'sólo contemplo la posibilidad de trabajar en ISO A4, A3 o A1
               Select Case Ancho / (respuesta +  '8 mm de margen de impresión
                   Case Is > 2.4142 'A4->A1
                       Escala = Sqr(2) * 2 * Escala
                   Case Is > 1.7071 'A3->A1
                       Escala = 2 * Escala
                   Case Is > 1.2071 'A4->A3
                       Escala = Sqr(2) * Escala
                   Case Is > 0.8536 'Sin cambios
                       Escala = 1 * Escala
                   Case Is > 0.6036 'A3->A4
                       Escala = Sqr(2) / 2 * Escala
                   Case Is > 0.4268 'A1->A3
                       Escala = 0.5 * Escala
                   Case Else 'A1->A4
                       Escala = Sqr(2) / 4 * Escala
               End Select
               'simple (no cambia tamaño de papel ni escala, toma opciones por defecto)
               'Application.ActiveDocument.SendCommand ("_-plot" & vbCr & "_n" & vbCr & Application.ActiveDocument.Layouts.Item(i).Name & vbCr & vbCr & Impresora & vbCr & "_n" & vbCr & "_y" & vbCr & "_y" & vbCr)
               'detallada
               Application.ActiveDocument.SendCommand ("_-plot" & vbCr & "_y" & vbCr & Application.ActiveDocument.Layouts.Item(i).Name & vbCr & Impresora & vbCr & Papel & vbCr & "_m" & vbCr & "_l" & vbCr & "_y" & vbCr & "_e" & vbCr & CStr((1000000 * Escala) \ 1000000) & "." & CStr((1000000 * Escala) Mod 1000000) & vbCr & "_c" & vbCr & "_y" & vbCr & Plumilla & vbCr & vbCr & vbCr & vbCr & vbCr & vbCr & "_y" & vbCr & "_y" & vbCr)
           End If
       Next
       'guardo y cierro el archivo
       Application.ActiveDocument.SendCommand ("_qsave" & vbCr & "_close" & vbCr)
       While Application.Documents.Count  numArchivos 'espero a que se cierre, para no tener muchos archivos abiertos
           DoEvents
       Wend
   End If
Next
End Sub

ADITIONAL COMMENTS

This 3 files must be in the same folder, but not neccesary to be the folder in which there are the CAD drawings to plot.

If user types incorrectly the data, macro will fall.

Macro would run faster if virus macro protection is disabled.

If the files are configured to plot in a ISO A1 but we need to plot a reduction on ISO A3, macro will change plot scale accordingly.

The macro uses "Plot Extension" and "Plot page centered". All other plot options are chosen by default.

The macro prevents AutoCAD to open too many files, waiting for a while to close each file when it finishes with it.

Plot configuration changes are saved in each file, so, at the end, all files are configured to the same printer, the same paper size and the same plot style.

It's similar to the use of PUBLISH command, with some minor advantages.

It is possible to use this code into a VBP file and load it when AutoCAD starts, making possible to use the macro whenever you want. You can customize palette buttons creating a new user-defined button to run this macro.

I apologize for my english: I'm spanish.

I hope it would be useful for someone.

Bye!

ImprimeLote.zip

[VVA]

Or use Terry Miller's PlotDwgs

PlotDwgs is a plot utility program with several unique options including plotting all open drawings, and plotting a folder of user selected drawings. Drawings may be plotted to a specified size, or by selecting the "Varies" option, the program determines the correct paper size to plot. Also included is the option of plotting all layouts in reverse order, and plotting a folder of user selected drawings in reverse order. The associated files are PlotDwgs.lsp, PlotDwgs.dcl and PlotDwgs.dvb.

[jaconbue]

Hi.

In my own Visual Basic Macro as well as in Terry Miller's PlotDwgs is neccesary to translate many localized commands (if you use a localized version of AutoCAD).

For example, "-PLOT" (english) may be replaced by "-TRAZADOR" (spanish).

Some answers in command line, like "Y" (yes) should be replaced by "S" (s

[VVA]

There is no necessity to translate the name of English commands in names of commands of the localised versions. There is enough before English commands and english options to use a prefix "_"

For example:

(command "[color="Red"]_[/color]PSPACE")
(command "[color="Red"]_[/color]LINE" "0,0" "10,0" "10,10" "[color="Red"]_[/color]C")
(command "[color="Red"]_[/color]-PLOT" "[color="Red"]_[/color]Y"  ...)

[Lee Mac]

There is no necessity to translate the name of English commands in names of commands of the localised versions. There is enough before English commands and english options to use a prefix "_"

For example:

(command "[color=Red]_[/color]PSPACE")
(command "[color=Red]_[/color]LINE" "0,0" "10,0" "10,10" "[color=Red]_[/color]C")
(command "[color=Red]_[/color]-PLOT" "[color=Red]_[/color]Y"  ...)

Also see here for help on this topic.

[jaconbue]

Thanks for those comments. I 've reviewed my code and parse accordingly. New version in first post. Bye!