Enterprise Architect Automation – Save/Export All Diagrams as Pictures

I’ve recently used Sparx’s Enterprise Architect (EA) tool for one of my projects to create various design diagrams (use-case diagrams, activity diagrams, sequence diagrams and class diagrams, etc.). While the tools like Visio are able to produce data models and class structures for conventional programming languages, in addition to that, EA can be used to create data models and diagrams for frameworks like SharePoint too.

In EA, user can create new data types for their frameworks and the data types can be mapped against the conventional SQL data types. I was able to generate the SharePoint list logical data models using that feature.

• The important feature of Sparx is, It’s able to import the code from the .NET source files and generates the class structures.
• The graphical representations of elements (objects) and connectors are beautiful and it supports different output formats like BMP, PNG, JPG and PDF, etc.
• It has powerful automation functionality which are exposed via COM. Programmers can automate the repetitive tasks of Sparx via VBScript, JavaScript, VB6, .NET, etc.

Here is the script to automate the creation of images from the diagrams created with single mouse click. This VBScript code is based on the sample script mentioned in the following link:

• http://stackoverflow.com/questions/1441479/automated-method-to-export-enterprise-architect-diagrams

option explicit
!INC Local Scripts.EAConstants-VBScript

‘ Global reference to the current project interface
dim projectInterface as EA.Project
dim foldername
‘ Show the script output window
Repository.EnsureOutputVisible "Script"
foldername = "c:\\temp\\"
ExportAllDiagrams()
sub ExportAllDiagrams()
    ‘ Show the script output window
    Repository.EnsureOutputVisible "Script"
    set projectInterface = Repository.GetProjectInterface()
    
    ‘ Iterate through all model nodes
    dim currentModel as EA.Package
    for each currentModel in Repository.Models
        ‘ Iterate through all child packages and save out their diagrams
        dim childPackage
        for each childPackage in currentModel.Packages
            DumpDiagrams childPackage, foldername
        next
        
    next
    Session.Output "Done!"  
end sub
‘
‘ Recursively saves all diagrams under the provided package and its children
‘
sub DumpDiagrams ( thePackage, byval subfoldername )

    'Cast thePackage to EA.Package so we get intellisense
    dim currentPackage as EA.Package
    set currentPackage = thePackage
    
    dim newfoldername
    newfoldername = trim(replace( replace_
    ( thePackage.Name, ":", ""), ".", ""))
    if newfoldername <> "" then
        ‘ Save and close the diagram
        subfoldername =  subfoldername + newfoldername  + "\\"
        
        CreateFolder subfoldername
    end if
    
    'Iterate through all diagrams in the current package
    dim currentDiagram
    dim filename
    for each currentDiagram in currentPackage.Diagrams
        filename = trim(replace( replace_
        ( currentDiagram.Name, ":", ""), ".", ""))
        if filename <> "" then
            ‘ Open the diagram
            Repository.OpenDiagram( currentDiagram.DiagramID )
            projectInterface.SaveDiagramImageToFile GetFilename(subfoldername ,filename + ".png", 1)
            Repository.CloseDiagram( currentDiagram.DiagramID )
        end if
    next
    ‘ Iterate through all diagrams in the sub package
    dim childPackage ‘as EA.Package
    for each childPackage in currentPackage.Packages
        DumpDiagrams childPackage, subfoldername
    next
    
end sub
Function GetFilename(thefoldername, theFilename, byval thesequence )
   Dim fso, f
   Set fso = CreateObject("Scripting.FileSystemObject")
   
   dim nametocheck
   if thesequence = 1 then
       nametocheck = thefoldername + theFilename
   else
       nametocheck = thefoldername + cstr(thesequence) + theFilename
   end if
        
   If fso.FileExists(nametocheck) Then
        GetFilename = GetFilename(thefoldername, theFilename, thesequence + 1 ) 
   else
        if thesequence = 1 then
            GetFilename = thefoldername + theFilename
        else
            GetFilename = thefoldername + cstr(thesequence) + theFilename
        end if
   End if
   
End Function
Function CreateFolder( theFolder )
   Dim fso, f
   Set fso = CreateObject("Scripting.FileSystemObject")
   If not fso.FolderExists(theFolder) Then
    Set f = fso.CreateFolder(theFolder)
  End if
End Function