VBA Macro AutoCAD : DWG to PDF

[Anonymous]

Hi,

I have to create a VBA macro for AutoCAD, but I'm not a VBA expert... 

The goal of my macro is :

1. Get all the DWG in a specific directory
2. Open DWG
3. Convert them to PDF
4. Rename & Move the PDF to another specific directory
5. Close the DWG
6. Loop on the next DWG File

Actually, there is what my macro does :

1. Get all the DWG in a specific directory
2. Open DWG (only the first)
3. Convert them to PDF
4. Rename & Move the PDF to another specific directory

I have to main issue :

• I don't know how to close my DWG
• The macro crash at the conversion part at the 2nd DWG

The macro :

Sub DWGtoPDF()

Dim file As String
Dim path As String
Dim destinationPath As String

path = "D:\Users\merel.thomas\Documents\test\dwg\"
destinationPath = "D:\Users\merel.thomas\Documents\test\pdf\"

'Get all DWG from directory
file = dir$(path & "*.DWG")

'Loop on all DWG files
While file <> ""

ThisDrawing.Application.Documents.Open path & file

Dim currentplot As AcadPlot
Set currentplot = ThisDrawing.Plot

ThisDrawing.ActiveLayout.ConfigName = "DWG To PDF.pc3" 'Plot device
ThisDrawing.ActiveLayout.CanonicalMediaName = "ANSI_full_bleed_D_(34.00_x_22.00_Inches)" 'PDF format

ThisDrawing.ActiveLayout.CenterPlot = True

ThisDrawing.ActiveLayout.StandardScale = acScaleToFit
ThisDrawing.Application.ZoomExtents

'Convertion DWG to PDF
' FAIL HERE
currentplot.PlotToDevice

Dim splitedFileName() As String
Dim fileName As String

splitedFileName = Split(file, ".")
fileName = splitedFileName(0)

Dim originalPdfFile As String
Dim destinationPdfFile As String

originalPdfFile = path & fileName & "-Model.pdf"
destinationPdfFile = destinationPath & fileName & ".pdf"

Line1:
g_sb_Delay 26 'Waiting until the PDF is created
If dir(originalPdfFile) <> "" Then
'Move + rename PDF file
Name originalPdfFile As destinationPdfFile
Else
GoTo Line1 'If PDF is not created after x seconds, retry
End If

'Close file
' FAIL HERE
AcadApplication.Documents.Close
Wend
End Sub

Public Sub g_sb_Delay(ai_Count As Long)

Dim Start As Long
Dim I As Long
I = 0

Start = Timer ' Set start time.
Do While Timer < Start + ai_Count
DoEvents ' Yield to other processes.
Loop

End Sub

Can anyone help me ?

[norman.yuan · Accepted solution]

Firstly, please use the "</>" button on top of the message text box to post code, so that the code is posted in read-able format.

Now regarding the errors you get:

1. Error on currentplot.PlotToDevice

The code should be:

currentplot.PlotToFile "[pdf file path/anme]"

because you are plotting to PDF file, right? So, you need to supply a desired file path/name here, not to rename the PDF file after plotting (you do not even know where the PDF file is!)

2. Error on AcadApplication.Documents.Close

AcadDocuments.Close() closes ALL drawings, not only the drawing you just opened for plotting.

3. Since the code needs to close each drawing after PDF plotting, you need to make sure the plotting is finished before the code in the "While...Wend" loop does the closing, thus, you need to disable background plotting. That is, you need to set system variable "BACKGROUNDPLOT" to 0 before your code does the plotting (and restore it back to its original value after the plotting is done. You do not use an empty "DO...Loop" to wait the background plotting to be finished.

To make the code a bit easier to read/debug, you might to organize it like this:

Public Sub DoPdfPlot()
    Dim backPlot As Integer
    backPlot=ThisDrawing.GetSysVariable("BACKGROUNDPLOT)
    ThisDrawing.SetSysVariable "BACKGROUNDPLOT", 0
    Dim fileNames() As String
    fileNames=GetFileNames("C:\....\dwgFolder")
    Dim fName as string

    Dim pdfName as string
    Dim dwg As AcadDocument
    Dim i As Integer
    For i = 0 to Ubound(fileNames)
        fName=fileNames(i)
        pdfName=    ''Determine PDF name based on DWG file name
        set dwg = AcadApplication.Documents.Open(fName)
        PlotToPdf dwg, pdfName
        dwg.Close false
    Next
    ThisDrawing.SetSysVariable "BACKGROUNDPLOT" baclPlot
End Sub

Private Function GetFileNames(path As String) As String()

    Dim fileName() As string
    Dim i As Integer
    Dim file As String
    file=Dir(path & "*.dwg")

    While file<>""
        ReDim Preserve fileNames(i)
       fileNames(i)=file
       i=i+1
       file = Dir
    Wend

    GetFileNames=fileNames
End Function

Private Sub PlotToPdg(dwg As AcadDocument, pdfFile As String)

    ''  do your plotting work here against the "dwg" object, including
    ''  set up correct layout as the active one, set up plot type: layout/extents/window, scale...
    '' Then eventually call AcadPlot.PlotToFile with "pdfFile" as parameter.

End Sub

The code is not tested, and is just meant to provide some ideas. 

HTH

[Anonymous]

Hi

Perfect, thanks a lot for the reply !

Sorry for the code block, i didn't see the button ^^

I use your solution and adapt it and it work perfectly

There is the final version of the macro for those who need it :

Public Sub DoPdfPlot()
    Dim backPlot As Integer
    ''Setting background plot variable
    backPlot = ThisDrawing.GetVariable("BACKGROUNDPLOT")
    ThisDrawing.SetVariable "BACKGROUNDPLOT", 0
    Dim fileNames() As String
    Dim oPath As String
    Dim dPath As String
    
    ''Original path -> Where DWG are
    oPath = "C:\...\dwg\"
    ''Destination path -> Where PDF go
    dPath = "C:\...\pdf\"
    
    fileNames = GetFileNames(oPath)
    Dim fName As String

    Dim pdfName As String
    Dim dwg As AcadDocument
    Dim i As Integer
    For i = 0 To UBound(fileNames)
        fName = fileNames(i)
        
        Dim splitedFileName() As String
        Dim brutName As String
        
        ''Name de PDF "[DWGName].pdf"
        splitedFileName = Split(fName, ".")
        brutName = splitedFileName(0)
        
        pdfName = dPath & brutName & ".pdf" ''Determine PDF name based on DWG file name
        Set dwg = AcadApplication.Documents.Open(fName)
        PlotToPdf dwg, pdfName
        dwg.Close False
    Next
    ThisDrawing.SetVariable "BACKGROUNDPLOT", backPlot
End Sub

Private Function GetFileNames(path As String) As String()
    
    Dim fileNames() As String
    Dim i As Integer
    Dim file As String
    ''Get all DWG file from the Original Path
    file = Dir(path & "*.dwg")

    While file <> ""
        ReDim Preserve fileNames(i)
        fileNames(i) = file
        i = i + 1
        file = Dir
    Wend

    GetFileNames = fileNames
End Function

Private Sub PlotToPdf(dwg As AcadDocument, pdfFile As String)

    ThisDrawing.ActiveLayout.ConfigName = "DWG To PDF.pc3" 'Plot device
    ThisDrawing.ActiveLayout.CanonicalMediaName = "ANSI_full_bleed_D_(34.00_x_22.00_Inches)" 'PDF format
    
    ThisDrawing.ActiveLayout.CenterPlot = True
                
    ThisDrawing.ActiveLayout.StandardScale = acScaleToFit
    ThisDrawing.Application.ZoomExtents
    
    Set currentplot = dwg.Plot
    ''Convertion step
    currentplot.PlotToFile pdfFile
End Sub

[maratovich]

I do not think that this is final.
And what if you need to print everything in different formats?

[Anonymous]

You can change 

ThisDrawing.ActiveLayout.ConfigName

And

ThisDrawing.ActiveLayout.CanonicalMediaName

easily, so, just add some parameters to the PlotToPdf function, but actually, i don't need it and i think i gonna need it in the future...

But i have another request that I don't know know how to do this :

I need to write another macro for :

1. Open AutoCAD
2. Launch this macro (Project.dvb)
3. Close AutoCAD
4. Close AcrobatReader

I don't know if i should use Batch, VBA or Lisp and i don't know how to do it...

[Anonymous]

Hi,

Can you  give me a vba macro programming to convert pdf to dwg ??

Thanks 

[Anonymous]

Hi,

Can you please write for me a vba macro fpr converting pdf to dwg ???

Thanks in advance

[maratovich]

No problems :

[Anonymous]

Thanks in advance !!

[maratovich]

Did you watch the video in the previous post ?

[Anonymous]

Cool !

[Anonymous]

Hi !

How is the PDF to DWG macro coming up ???

Thanks in advance

[Anonymous]

HI,

I am new to AutoCAD and Macros, I have tried your code but it stuck at below line saying drawing not found, however drawing is present in the directory.

Set dwg = AcadApplication.Documents.Open(fName)

Please help me in this regards, this error is not making any sense to me.

[ed57gmc]

Show your code.

[Anonymous]

Private Sub rename_Click()

Dim backPlot As Integer
''Setting background plot variable
backPlot = ThisDrawing.GetVariable("BACKGROUNDPLOT")
ThisDrawing.SetVariable "BACKGROUNDPLOT", 0
Dim fileNames() As String
Dim oPath As String
Dim dPath As String

''Original path -> Where DWG are
oPath = "C:\Documents and Settings\Administrator\Desktop\New Folder\"
''Destination path -> Where PDF go
dPath = "C:\Documents and Settings\Administrator\Desktop\PDF\"

fileNames = GetFileNames(oPath)
Dim fName As String

Dim pdfName As String
Dim dwg As AcadDocument
Dim i As Integer
For i = 0 To UBound(fileNames)
fName = fileNames(i)

Dim splitedFileName() As String
Dim brutName As String

''Name de PDF "[DWGName].pdf"
splitedFileName = Split(fName, ".")
brutName = splitedFileName(0)

pdfName = dPath & brutName & ".pdf" ''Determine PDF name based on DWG file name
'Set dwg = AcadApplication.Documents.Open(fName)
PlotToPdf dwg, pdfName
dwg.Close False
Next
ThisDrawing.SetVariable "BACKGROUNDPLOT", backPlot
End Sub

Private Function GetFileNames(path As String) As String()

Dim fileNames() As String
Dim i As Integer
Dim file As String
''Get all DWG file from the Original Path
file = Dir(path & "*.dwg")

While file <> ""
ReDim Preserve fileNames(i)
fileNames(i) = file
i = i + 1
file = Dir
Wend

GetFileNames = fileNames
End Function

Private Sub PlotToPdf(dwg As AcadDocument, pdfFile As String)
Dim currentplot As AcadPlot

ThisDrawing.ActiveLayout.ConfigName = "DWG To PDF.pc3" 'Plot device
ThisDrawing.ActiveLayout.CanonicalMediaName = "ANSI_full_bleed_D_(34.00_x_22.00_Inches)" 'PDF format

ThisDrawing.ActiveLayout.CenterPlot = True

ThisDrawing.ActiveLayout.StandardScale = acScaleToFit
ThisDrawing.Application.ZoomExtents

Set currentplot = dwg.Plot
''Convertion step
currentplot.PlotToFile pdfFile
End Sub

In opath and dpath if remove the last backslash(\) of directory the code gives an error at For i = 0 To UBound(fileNames) stating "subscript out of range" if I put backslash it stuck at Set dwg = AcadApplication.Documents.Open(fName) saying file not found even though the error has file name which is present in the directory.

I tried to comment Set dwg = AcadApplication.Documents.Open(fName)  the code shows error at ThisDrawing.ActiveLayout.CanonicalMediaName = "ANSI_full_bleed_D_(34.00_x_22.00_Inches)"  stating invalid input.

I am using autocad 2008.

Regards,

[ed57gmc]

---

@Anonymous wrote:

In opath and dpath if remove the last backslash(\) of directory the code gives an error at For i = 0 To UBound(fileNames) stating "subscript out of range" if I put backslash it stuck at Set dwg = AcadApplication.Documents.Open(fName) saying file not found even though the error has file name which is present in the directory.

---

If there aren't any files, you will get the 'out of range' error on this line: For i = 0 To UBound(fileNames), when the UBound function fails. Typically, users don't have access to the "Documents and Settings" folder. Try using C:\Users\Public\Documents\Dwg\ instead.

[Anonymous]

Hi Ed,

Sorry for delay response.

I tried your suggestion by creating PDF and DWG folder in C drive; like C:\PDF\ and C:\DWG\ but the problem is same. it gives the error that dwg file is not found at 

Set dwg = AcadApplication.Documents.Open(fName)

 Regards,

[ed57gmc]

The problem is not with the code. Obviously, it can't find it where you put the files. In Windows 10, rights are restricted in C:\ as well. Either that or you misspelled something. Try putting the files where you are positive users have rights to. That's why I suggested the Public profile. Try the pat I gave you before you assume something is wrong with the code. You can also use a network share which provides the necessary rights.

[wianeh6700]

What if want to use a window so select the extent, Any Ideas please? can i create a layer that specifies the my extent

ThisDrawing.ActiveLayout.StandardScale = acScaleToFit

ThisDrawing.Application.ZoomExtents

[ed57gmc]

See this topic. You can't create a layer to specify what to plot, but you can create a named View. Then you can assign the view to the current page setup.

BTW, your post has nothing to do with this thread. You should have started a new thread.