IAcad plot failed vba

[Anonymous]

Hello community i have the below code. This code works perfectly for one drawing of autocad, when it goes to the second one. It prints me an error. IAcadPlot failed. Why is that?

The below code is an iteration from a file that opens a drawing one at a time and converts it to PNG and stores it to a new location. 

In order for you to setup you need:

A folder at c:/t/dwgFolder

A folder at c:/t/PNG_files_Storage

And a custom paper size.In my case it is named "my_paper_size"

Then you can start debugging. Add two drawings to the dwgFolder.

Public Sub MainForPngStep()
    Dim DrawingList As Collection
    'First we must see if drawings exist from meridian if there are no drawings we should quit Autocad'
    Set DrawingList = GetDrawingsFilePath()
    If DrawingList.Count = 0 Then
        'No drawings were indide the folder so Autocad should close'
         AcadApplication.Quit
    End If
    'If the above statement is not true then we have drawings to convert'
    'So we need to open them and print to png'
    
     'Then we iterate over the collection for the program to '
    For Each drawing In DrawingList
        PrintToPng (drawing)
        'The final step is to close the drawing'
        ThisDrawing.Close (False)
    Next
    
    
End Sub

Public Function GetDrawingsFilePath() As Collection
    'This does work
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim i As Integer
    Dim drawingCollection As New Collection
    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Get the folder object
    Set objFolder = objFSO.GetFolder("C:\t\dwgFolder")
    'loops through each file in the directory and prints their names and path
    Dim filePath As String
    For Each objFile In objFolder.Files
        'MsgBox (CStr(objFile.Path))
        filePath = CStr(objFile.Path)
        drawingCollection.Add filePath
    Next objFile
    Set GetDrawingsFilePath = drawingCollection
   
End Function
Public Function PrintToPng(filePath As String) As Boolean
    'We call the open drawings here because '
    Dim CanOpenDrawing As Boolean
    CanOpenDrawing = OpenDrawings(filePath)
    If CanOpenDrawing = False Then
        'This means we could not open the drawing so we have to iterate to the next one'
        'Failing here is the same of failing at converting for png'
        PrintToPng = False
    End If
    
    'This should be a constant since it is our test directory'
    'This directory is where all the PNG files will be stored'
    ZoomExtents
    Dim sourceDir As String
    sourceDir = "C:\t\PNG_files_Storage\"
    'These three variables will help set the paper size'
    Dim mediaNames As Variant
    Dim name As String
    Dim siz As String
    'In this value the complete path will be stored'
    Dim pngFile As String
    
    'This value will be responsible for storing the full name of the active drawing'
    Dim drawingName As String

    Dim pngExtension As String
    pngExtension = ".png"
    
    'MsgBox (ThisDrawing.Name)
    drawingName = ThisDrawing.name
    'First we must remove the .dwg extension'
    drawingName = TrimPath(drawingName)
    'Then We build the final path'
    pngFile = ConcatenateString(sourceDir, drawingName)
    pngFile = ConcatenateString(pngFile, pngExtension)
    MsgBox (pngFile)
    Dim layout As AcadLayout
    Set layout = ThisDrawing.ActiveLayout
    'Do not really know Autocad has some pre configurations for printing reasonable'
    layout.ConfigName = "PublishToWeb PNG.pc3"
    layout.PaperUnits = acPixels
    
    'Here we set the paper size'
    siz = "my_paper_size"
    mediaNames = layout.GetCanonicalMediaNames
    
    For x = LBound(mediaNames) To UBound(mediaNames)
        name = layout.GetLocaleMediaName(mediaNames(x))
        If InStr(1, name, siz, vbTextCompare) = 1 Then
            layout.CanonicalMediaName = mediaNames(x)
            layout.RefreshPlotDeviceInfo
        End If
    Next
    
    
    Dim result As Boolean
        
    result = ThisDrawing.Plot.PlotToFile(pngFile)
    
    
    If result Then
        PrintToPng = result
    Else
        PrintToPng = result
    End If

End Function
Function OpenDrawings(filePath As String) As Boolean
    dwgName = filePath
    If Dir(dwgName) <> "" Then
        ThisDrawing.Application.Documents.Open dwgName
        OpenDrawings = True
    Else
        OpenDrawings = False
    End If
End Function
'Helper Functions'
Public Function ConcatenateString(first As String, second As String) As String
    ConcatenateString = first + second
End Function
Public Function TrimPath(pathToTrim As String) As String
    Dim trimmedString As String
    trimmedString = pathToTrim
    trimmedString = RTrim(trimmedString)
    Dim length As Long
    length = Len(trimmedString)
    trimmedString = Left(trimmedString, length - 4)
    'MsgBox ("This is the trimmed path " & trimmedString)
    TrimPath = trimmedString
 End Function