Python - Wireframe graphics on the worksheet leveraging SVG 3D library

In this post I leverage a brilliant Python library by Philip Rideout which draws wireframe graphics to SVG files and then I convert the SVG drawing directives to Shapes on an Excel worksheet.

This means I can take this SVG file of an octahedron

and convert it to this on the Excel worksheet.

Background

On StackOverflow, a question arose about drawing a wireframe box. I had looked into drawing on the worksheet using GDI before but I ruled out that approach. Instead, it is required to draw shapes on the worksheet. GDI still works for drawing on a Form as this Stars and Stripes example demonstrates. Using the macro recorder helps to understand how to build a free form shape but we'd need to write some 3D maths library in VBA to calculate all the vertices etc.

Luckily a brilliant library written by Philip Rideout exists and can do all the business of defining wireframe shapes in terms of vertices and also how the camera is pointing and it will do all the hard mathematics and draw to an SVG file. Then, I give code which parses that SVG file (it is XML after all) and I convert the polygon drawing directives to Excel (Freeform) Shapes.

The Setup

In Visual Studio give yourself a new Python project. Add the svg3d.py file from Github. Also add the example.py file from Github. Set the example.py file to be the file to run on startup. As it stands the code will generate an SVG file of an octahedron, you can see a rendering at the top of this page. It is very good, the fill on the front sides is set to 75% opacity so you can still see the rear faces. The rear faces are drawn first meaning I don't have to worry about which faces are hidden etc.

What is now needed is just a little more code to open an Excel workbook so add the following to the end of the example.py file

class ScreenUpdatingRAII(object):
    def __init__(self, app, visible:bool=False):
        self.app = app
        self.saved = app.ScreenUpdating
        app.ScreenUpdating = visible

    def restore(self):
        self.app.ScreenUpdating = self.saved
        self.app = None


def convertSvgToExcelShapes(filename):
    import xml.etree.ElementTree as ET
    from win32com.client  import GetObject,Dispatch

    # code below is highly dependent on the child
    # structure because xpath was not working for me (my bad)
    dom = ET.parse(filename)
    rootxml = dom.getroot()
    g = rootxml[1] # second child 
    wb = Dispatch(GetObject(r"C:\Users\Simon\source\repos\WireframeExcelShapes\WireframeExcelShapes\WireframeExcelShapes.xlsx"))
    app = Dispatch(wb.Parent)
    ws = Dispatch(wb.Worksheets.Item("WireFrame"))

    shps = Dispatch(ws.Shapes)

    for x in shps:
        Dispatch(x).Delete()
    idx =0
    scale, xoffset, yoffset = 500, 300,300
    
    screenUpdates = ScreenUpdatingRAII(app)

    for polygon in g:

        # triple nested list comprehension parsing the points by splitting 
        # first by space then by comma then converting to float
        points = [[float(z[0])*scale+xoffset, float(z[1])*scale+yoffset] for z in [y.split(',') for y in [x for x in polygon.attrib['points'].split()]]]

        #print(points)
        msoEditingAuto,msoSegmentLine, msoFalse, msoTrue = 0,0,0, -1 

        freeformbuilder=shps.BuildFreeform(msoEditingAuto, points[0][0] , points[0][1])
        freeformbuilder.AddNodes(msoSegmentLine, msoEditingAuto, points[1][0] , points[1][1])
        freeformbuilder.AddNodes(msoSegmentLine, msoEditingAuto, points[2][0] , points[2][1])
        freeformbuilder.AddNodes(msoSegmentLine, msoEditingAuto, points[0][0], points[0][1])
        newShp = Dispatch(freeformbuilder.ConvertToShape())

        shpFill = Dispatch(newShp.Fill)

        shpFill.Visible = msoTrue
        shpFill.Transparency = 0.25
        shpFill.Solid
        shpFill.ForeColor.RGB = 0xFFFFFF 
        idx=+1

    screenUpdates.restore()
    pass

        

filename = "octahedron.svg" 
generate_svg(filename)
convertSvgToExcelShapes(filename)

First comes a class called ScreenUpdatingRAII() which I use to switch on screen updates whilst drawing. This speeds the code and also kills screen flicker.

Next comes the function convertSvgToExcelShapes() which loads the SVG file into Python's Element tree XML parser. Then using some COM calls will open an Excel workbook which you must have saved before hand, and then accesses a sheet called WireFrame which you must have created beforehand as well! The code deletes any Shapes from that sheet and then proceeds to draw an Excel free form shape for each Polygon element in the SVG file. I haven't really added much value here it was quite straightforward. The dramatic output is 99% to Philip's credit.

However, I am proud of a line of code I did contribute. My triple nested list comprehension parses the string of points co-ordinates, scales and translates (math) them ready for the worksheet...

points = [[float(z[0])*scale+xoffset, float(z[1])*scale+yoffset] for z in [y.split(',') for y in [x for x in polygon.attrib['points'].split()]]]

Links

Below is a link to Philip's blog and his Github repo.

• Philip Rideout's Github repo for the SVG wireframes code
• Philip Rideout's blog post on SVG wireframes

VBA - Sheet Diagram to SVG

The VBA code below will inspect the text, hyperlinks and borders of an Excel range on a worksheet and convert to SVG (Scalable Vector Graphics) for use in an HTML context.

I wanted more diagrams on my blog and I knew I wanted to use SVG but I did not want to wrestle with an HTML artwork package such as InkScape. I felt the Excel worksheet grid is a perfectly good way to layout a diagram so Excel is my authoring tool. You can see an example of a diagram converted to SVG, below is a screenshot of the original Excel worksheet. Even further below is the source code.

Note: to get working in a blog I have had to remove the namespaces. It is nice to see hyperlinks working albeit I used javascript when then the anchor element did not render.

Option Explicit

'* Tools->References
'* Microsoft Scripting Runtime
'* Microsoft Xml v6.0
'*

Sub Test()

    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject
    
    Dim sSVGPath As String
    sSVGPath = "N:\InterfaceDiagram6.svg"
    
    Dim txtOut As Scripting.TextStream
    Set txtOut = fso.CreateTextFile(sSVGPath)
    txtOut.WriteLine "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""no""?>"
    txtOut.WriteLine "<svg:svg id='Simon1' xmlns:svg=""http://www.w3.org/2000/svg"" xmlns:xlink='http://www.w3.org/1999/xlink'>"
    txtOut.WriteLine "<svg:g  id='Simon2' transform='scale(2)' >"

    Dim wb As Excel.Workbook
    Set wb = ThisWorkbook 'Set wb = Workbooks(1)
    
    Dim sht1 As Excel.Worksheet
    Set sht1 = wb.Worksheets.Item("Sheet1")

    Dim vRegions As Variant
    vRegions = Array(Array(sht1.Range("b4:c13"), "Group1"), _
                    Array(sht1.Range("d2:f20"), "Group2"), _
                    Array(sht1.Range("g2:h20"), "Group3"))
                    
                    
    Test2 txtOut, vRegions


    txtOut.WriteLine "</svg:g >"
    txtOut.WriteLine "</svg:svg>"

    txtOut.Close
    Set txtOut = Nothing

    Dim dom As MSXML2.DOMDocument60
    Set dom = New MSXML2.DOMDocument60
    
    Debug.Assert dom.Load(sSVGPath)

    Debug.Assert dom.parseError = 0

End Sub


Sub Test2(txtOut, ByVal vRegions As Variant)

    Dim vRegionsLoop
    For Each vRegionsLoop In vRegions
                
        Dim rng As Excel.Range
        Set rng = vRegionsLoop(0)
        
        Dim sRegionId
        sRegionId = vRegionsLoop(1)
        
        txtOut.WriteLine "<svg:g id='" & sRegionId & "' >"
        
        Dim rngLoop As Excel.Range
        For Each rngLoop In rng.Cells
            txtOut.Write BordersToSvg(rngLoop)
            txtOut.Write TextToSvg(rngLoop)
        Next
    
        txtOut.WriteLine "</svg:g >"
    Next

End Sub


Function TextToSvg(ByVal rng As Excel.Range) As String
    Debug.Assert rng.Rows.Count = 1
    Debug.Assert rng.Columns.Count = 1

    Dim sText As String
    sText = rng.Value2

    If Len(sText) > 0 Then
    
        Dim fill As String
        fill = "fill:#000000"
    
        If rng.Hyperlinks.Count > 0 Then
            Dim lnk As Excel.Hyperlink
            Set lnk = rng.Hyperlinks.Item(1)
            
            Dim javascript As String
            javascript = " ondblclick=""window.open(&quot;" & lnk.Address & "&quot;)"" " & vbNewLine
            javascript = javascript & " onmouseover=""this.style['fill']='#ffc000';console.log(this.style['fill']);"" " & vbNewLine
            javascript = javascript & " onmouseout=""this.style['fill']='#2288bb';console.log(this.style['fill']);"" " & vbNewLine
            fill = "fill:#2288bb"
        End If
    
        Dim fnt As Excel.Font
        Set fnt = rng.Font
        
        Dim fntPx As Long
        fntPx = fnt.Size * 1 ' 4# / 3#
        
        
        Dim fntStyle As String
        fntStyle = "font-style:normal;font-weight:normal;font-size:" & fntPx & "px;line-height:1.25;font-family:sans-serif;letter-spacing:0px;word-spacing:0px;" & fill & ";fill-opacity:1;stroke:none"
    
        Dim x
        x = rng.Left
        
        Dim y
        y = rng.Top + rng.Height
    
        Dim sId As String
        sId = VBA.Replace(rng.Address, "$", "")

        Dim s As String
        s = vbNewLine
        s = s & "<svg:text id='" & sId & "txt' x='" & x & "' y='" & y & "' style='" & fntStyle & "' " & javascript & " >" & vbNewLine
        s = s & "<svg:tspan id='" & sId & "tspan'  x='" & x + 1.25 & "' y='" & y - 2 & "' >" & sText & "</svg:tspan>" & vbNewLine
        s = s & "</svg:text>" & vbNewLine
    End If
    TextToSvg = s

End Function

Function BordersToSvg(ByVal rng As Excel.Range) As String
    Debug.Assert rng.Rows.Count = 1
    Debug.Assert rng.Columns.Count = 1
    
    Dim dicKeyedByStyle As Scripting.Dictionary
    Set dicKeyedByStyle = New Scripting.Dictionary
    
    Dim vEdges As Variant
    vEdges = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
    
    Dim vEdges2 As Variant
    vEdges2 = Array("xlEdgeLeft", "xlEdgeTop", "xlEdgeBottom", "xlEdgeRight")
    
    Dim lEdgeLoop As Long
    For lEdgeLoop = 7 To 10
        
        Dim brd As Excel.Border
        Set brd = rng.Borders.Item(lEdgeLoop)
        
        If Not IsNull(brd.TintAndShade) Then
            
            Dim sLine As String
            sLine = ""
            
            If lEdgeLoop = xlEdgeBottom Then
                sLine = "M " & rng.Left & "," & rng.Top + rng.Height & " L " & rng.Left + rng.Width & "," & rng.Top + rng.Height
            ElseIf lEdgeLoop = xlEdgeTop Then
                sLine = "M " & rng.Left & "," & rng.Top & " L " & rng.Left + rng.Width & "," & rng.Top
            ElseIf lEdgeLoop = xlEdgeLeft Then
                sLine = "M " & rng.Left & "," & rng.Top & " L " & rng.Left & "," & rng.Top + rng.Height
            ElseIf lEdgeLoop = xlEdgeRight Then
                sLine = "M " & rng.Left + rng.Width & "," & rng.Top & " L " & rng.Left + rng.Width & "," & rng.Top + rng.Height
            End If
            
            Dim sStyleKey As String
            sStyleKey = "stroke-width:1;stroke:#" & Right$("000000" & Hex$(brd.Color), 6) & ";" & VBA.IIf(brd.LineStyle <> 1, "stroke-miterlimit:4;stroke-dasharray:2,2;stroke-dashoffset:0", "")
            
            If dicKeyedByStyle.Exists(sStyleKey) Then
                dicKeyedByStyle(sStyleKey) = dicKeyedByStyle(sStyleKey) & " " & sLine
            Else
                dicKeyedByStyle(sStyleKey) = sLine
            End If
        End If
    Next
    
    Dim lStyleLoop As Long
    For lStyleLoop = 0 To dicKeyedByStyle.Count - 1
    
        Dim vUniqueStyle As Variant
        vUniqueStyle = dicKeyedByStyle.Keys()(lStyleLoop)
        
        Dim sId As String
        sId = "id=""" & VBA.Replace(rng.Address, "$", "") & "_" & lStyleLoop & """"
        
        Dim sStyle As String
        sStyle = " style=""" & vUniqueStyle & """ "
        
        Dim sSvgHtml As String
        sSvgHtml = "<svg:path " & sId & sStyle & " d=""" & dicKeyedByStyle(vUniqueStyle) & """/>"
    
        BordersToSvg = BordersToSvg & sSvgHtml & vbNewLine
    Next

End Function

VBA - SVG - USA Stars and Stripes

A popular post on this blog from a while back was some VBA code to generate an SVG of the British Flag . SVG stands for Scalable Vector Graphics and is a key part of HTML5. Here I give more VBA code to draw the national flag on the United States of America, the stars and stripes. The code for the USA flag here is more compact.

There are two code modules below. I have split the flag specifications into a separate module because I want to go on and give code that will allow the stars and stripes to be drawn onto a VBA form using the Windows GDI API. Also, because of the upcoming GDI implementation I have borrowed some GDI type definitions such as RECT and POINTAPI.

The project requires references to two libraries. Microsoft XML, v6.0 and Microsoft Scripting Runtime. This is because SVG is a type of Xml and best manipulated as an Xml document. The Scripting Runtime is there to create output files.

I won't replicate the Mozilla Developer Network (MDN) documentation on SVG because it is excellent. So only a little explanation. For more information, follow the hypertext links to MDN in the following text.

Code walkthrough

Instructions for adding the modules are given below in the sections marked modUSAFlagSpecification and modUSAFlagSVG.

To run the code, go to procedure modUSAFlagSVG.DrawUSAFlagWithSVG() and press F5

To begin, we write a root svg element to a file as this is the easiest way to get started with the processing instruction and the namespace attribute of the root element. From then on, we load and manipulate the document with standard Xml library.

We set the viewbox attribute, and a single containing graphics element. It is possible to scale using the graphics element or to directly manipulate the co-ordinates. I set the dScalar variable for to scale the flag so that it fits nicely into this web page.

Much of the stars and stripes is based on drawing rectangles. It is easy to translate the rectangle co-ordinates into d attribute path commands.

There is code generate a five pointed star for a given coordinate pair, and we call this this 50 times with unique co-ordinates to give the 50 stars. Original code to generate the stars was found at the Draw a US Flag using C# and GDI+ - The Code Project, there it is written in C#. I add value here by converting to VBA. My thanks to original author Jack J. H. Xu. It is again easy to convert the series of star point co-ordinates into a d attribute path.

modUSAFlagSpecification standard module

So in a new project add a standard module and name it 'modUSAFlagSpecification' then copy in the code below.

Option Explicit

'*
'* Brought to you by the Excel Development Platform Blog
'* http://exceldevelopmentplatform.blogspot.com/2018/11/
'*

'*
'* https://en.wikipedia.org/wiki/Flag_of_the_United_States#Specifications
'*
Private Const mlHeight As Double = 1000#                            '* A
Private Const mlWidth As Double = 1900#                             '* B
Private Const mlHoist As Double = mlHeight * 7 / 13                 '* C
Private Const mlFly As Double = mlWidth * 2 / 5                     '* D
Private Const mlHoistTenth As Double = mlHoist / 10                 '* E,F
Private Const mlFlyTwelth As Double = mlFly / 12                    '* G,H

Private Const mlStripeWidth = mlHeight / 13                         '* L
Private Const mlStarDiameter = mlStripeWidth * 4 / 5                '* K


Public Type RGB
    R As Long
    G As Long
    B As Long
End Type

Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Public Type POINTAPI
    x As Long
    y As Long
End Type

Public Sub GetOldGloryRed(ByRef pURGB As RGB)
    pURGB.R = &HB2 '* https://en.wikipedia.org/wiki/Flag_of_the_United_States#Colors
    pURGB.G = &H22
    pURGB.B = &H34
End Sub


Public Sub GetOldGloryBlue(ByRef pURGB As RGB)
    pURGB.R = &H3C '* https://en.wikipedia.org/wiki/Flag_of_the_United_States#Colors
    pURGB.G = &H3B
    pURGB.B = &H6E
End Sub


Public Sub GetWhite(ByRef pURGB As RGB)
    pURGB.R = &HFF '* https://en.wikipedia.org/wiki/Flag_of_the_United_States#Colors
    pURGB.G = &HFF
    pURGB.B = &HFF
End Sub

Public Sub FivePointedStar(ByVal dMultiplier As Double, ByVal dRadius As Double, _
                ByVal dXCentre As Double, ByVal dYCentre As Double, _
                ByRef pauPoint() As POINTAPI, ByRef plPointCount As Long)

    ReDim auPoint(0 To 9) As POINTAPI


    Const Pi As Double = 3.14159265358979

    dRadius = dRadius * dMultiplier
    '*
    '* Algorithm by Jack J. H. Xu - https://www.codeproject.com/script/Membership/View.aspx?mid=3946205
    '* Code Project https://www.codeproject.com/Articles/18149/Draw-a-US-Flag-using-C-and-GDI
    '*

    Dim dSin36 As Double, dSin72 As Double, dCos36 As Double, dCos72 As Double
    dSin36 = Sin(36# * Pi / 180#)
    dSin72 = Sin(72# * Pi / 180#)
    dCos36 = Cos(36# * Pi / 180#)
    dCos72 = Cos(72# * Pi / 180#)

    Dim dInnerRadius As Double
    dInnerRadius = dRadius * dCos72 / dCos36

    auPoint(0).x = dXCentre
    auPoint(0).y = dYCentre - dRadius

    auPoint(1).x = dXCentre + dInnerRadius * dSin36
    auPoint(1).y = dYCentre - dInnerRadius * dCos36

    auPoint(2).x = dXCentre + dRadius * dSin72
    auPoint(2).y = dYCentre - dRadius * dCos72

    auPoint(3).x = dXCentre + dInnerRadius * dSin72
    auPoint(3).y = dYCentre + dInnerRadius * dCos72

    auPoint(4).x = dXCentre + dRadius * dSin36
    auPoint(4).y = dYCentre + dRadius * dCos36

    auPoint(5).x = dXCentre
    auPoint(5).y = dYCentre + dInnerRadius

    auPoint(6).x = dXCentre - dRadius * dSin36
    auPoint(6).y = dYCentre + dRadius * dCos36

    auPoint(7).x = dXCentre - dInnerRadius * dSin72
    auPoint(7).y = dYCentre + dInnerRadius * dCos72

    auPoint(8).x = dXCentre - dRadius * dSin72
    auPoint(8).y = dYCentre - dRadius * dCos72

    auPoint(9).x = dXCentre - dInnerRadius * dSin36
    auPoint(9).y = dYCentre - dInnerRadius * dCos36

    pauPoint = auPoint
    plPointCount = 10

End Sub

Public Sub WhiteStars(ByVal dMultiplier As Double, ByRef pauRect() As RECT)
    ReDim auRect(0 To 49) As RECT

    Dim lLoop As Long
    For lLoop = 0 To 49
        Dim lMod As Long
        lMod = lLoop Mod 11  '* Pattern repeats every 11 stars

        Dim lBlock As Long
        lBlock = lLoop \ 11

        If lMod <= 5 Then
            '*
            '* we are in a row of six stars
            '*
            auRect(lLoop).Left = ((lMod * 2) + 1) * mlFlyTwelth * dMultiplier
            auRect(lLoop).Right = auRect(lLoop).Left + (mlStarDiameter * dMultiplier)
            auRect(lLoop).Top = (1 + lBlock * 2) * mlHoistTenth * dMultiplier
            auRect(lLoop).Bottom = auRect(lLoop).Top + (mlStarDiameter * dMultiplier)

        Else
            '*
            '* we are in a row of fives stars
            '*
            Dim lMod2 As Long
            lMod2 = lMod Mod 6

            auRect(lLoop).Left = ((lMod2 + 1) * 2) * mlFlyTwelth * dMultiplier
            auRect(lLoop).Right = auRect(lLoop).Left + (mlStarDiameter * dMultiplier)
            auRect(lLoop).Top = (((1 + lBlock) * 2)) * mlHoistTenth * dMultiplier
            auRect(lLoop).Bottom = auRect(lLoop).Top + (mlStarDiameter * dMultiplier)

        End If

    Next lLoop

    pauRect = auRect
End Sub

Public Sub WhiteStripes(ByVal dMultiplier As Double, ByRef pauRect() As RECT)

    ReDim auRect(0 To 5) As RECT

    Dim lLoop As Long
    For lLoop = 0 To 5

        auRect(lLoop).Left = VBA.IIf(lLoop <= 2, mlFly * dMultiplier, 0)
        auRect(lLoop).Right = mlWidth * dMultiplier
        auRect(lLoop).Top = mlStripeWidth * ((lLoop * 2) + 1) * dMultiplier
        auRect(lLoop).Bottom = auRect(lLoop).Top + (mlStripeWidth * dMultiplier)
    Next lLoop

    pauRect = auRect


End Sub


Public Function RedStripes(ByVal dMultiplier As Double, ByRef pauRect() As RECT)

    ReDim auRect(0 To 6) As RECT

    Dim lLoop As Long
    For lLoop = 0 To 6

        auRect(lLoop).Left = VBA.IIf(lLoop <= 3, mlFly * dMultiplier, 0)
        auRect(lLoop).Right = mlWidth * dMultiplier
        auRect(lLoop).Top = mlStripeWidth * (lLoop * 2) * dMultiplier
        auRect(lLoop).Bottom = auRect(lLoop).Top + (mlStripeWidth * dMultiplier)

    Next lLoop

    pauRect = auRect


End Function



Public Function BlueCanton(ByVal dMultiplier As Double, ByRef pauRect() As RECT)
    ReDim auRect(0 To 0) As RECT

    auRect(0).Left = 0
    auRect(0).Top = 0
    auRect(0).Right = mlFly * dMultiplier
    auRect(0).Bottom = mlHoist * dMultiplier

    pauRect = auRect '* copy over to return

End Function

modUSAFlagSVG standard module

Again, add a standard module, this time name it 'modUSAFlagSVG'. This module will call into module modUSAFlagSpecification so you should add that first. The following module also requires some libraries, Microsoft Scripting Runtime and Microsoft XML, v6.0. You will need to change the output filename.

Option Explicit

'*
'* Brought to you by the Excel Development Platform Blog
'* http://exceldevelopmentplatform.blogspot.com/2018/11/
'*

'* Tools->References: Microsoft Scripting Runtime
'* Tools->References: Microsoft XML, v6.0

'* Requires module modUSAFlagSpecification

Private Sub DrawUSAFlagWithSVG()

    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject

    Dim sSVGPath As String
    sSVGPath = "N:\StarsAndStripes.svg"  '<--- change for you

    Dim txtOut As Scripting.TextStream
    Set txtOut = fso.CreateTextFile(sSVGPath)

    txtOut.WriteLine "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""no""?>"
    txtOut.WriteLine "<svg:svg xmlns:svg=""http://www.w3.org/2000/svg"" />"

    txtOut.Close
    Set txtOut = Nothing

    If fso.FileExists(sSVGPath) Then

        Dim dom As MSXML2.DOMDocument60
        Set dom = New MSXML2.DOMDocument60

        dom.Load sSVGPath

        Debug.Assert dom.parseError = 0


        Dim uRed As RGB
        Call modUSAFlagSpecification.GetOldGloryRed(uRed)

        Dim sRed_Style As String
        sRed_Style = "fill:#" & Hex$(uRed.R) & Hex$(uRed.G) & Hex$(uRed.B) & ";fill-opacity:1"

        Dim uBlue As RGB
        Call modUSAFlagSpecification.GetOldGloryBlue(uBlue)

        Dim sBlue_Style As String
        sBlue_Style = "fill:#" & Hex$(uBlue.R) & Hex$(uBlue.G) & Hex$(uBlue.B) & ";fill-opacity:1"


        dom.setProperty "SelectionNamespaces", "xmlns:svg=""http://www.w3.org/2000/svg"""

        Dim xmlSVG As MSXML2.IXMLDOMElement
        Set xmlSVG = dom.SelectSingleNode("svg:svg")
        Call xmlSVG.setAttribute("viewbox", "0 0 600 300")
        'Call xmlSVG.setAttribute("width", "1200")
        'Call xmlSVG.setAttribute("height", "600")
        'Call xmlSVG.setAttribute("width", "210mm")
        'Call xmlSVG.setAttribute("height", "297mm")
        Call xmlSVG.setAttribute("version", "1.1")


        Dim xmlGTranslate As MSXML2.IXMLDOMElement
        Set xmlGTranslate = dom.createElement("svg:g")
        Call xmlGTranslate.setAttribute("id", "TranslateToCentre")

        Dim dScalar As Double
        dScalar = 0.7


        xmlSVG.appendChild xmlGTranslate
        dom.Save sSVGPath

        Dim auRects() As RECT
        Call modUSAFlagSpecification.BlueCanton(dScalar, auRects)
        DrawRects xmlGTranslate, "BlueCanton", sBlue_Style, auRects

        Call modUSAFlagSpecification.RedStripes(dScalar, auRects)
        DrawRects xmlGTranslate, "RedStripe", sRed_Style, auRects

        Call modUSAFlagSpecification.WhiteStripes(dScalar, auRects)
        DrawRects xmlGTranslate, "WhiteStripe", "fill:#FFFFFF;fill-opacity:1", auRects


        Call modUSAFlagSpecification.WhiteStars(dScalar, auRects)
        DrawStars xmlGTranslate, "WhiteStar", "fill:#FFFFFF;fill-opacity:1", auRects, dScalar

        dom.Save sSVGPath


    End If


End Sub

Private Sub DrawStars(ByVal xmlParentElement As MSXML2.IXMLDOMElement, ByVal sIdPrefix As String, ByVal sStyle As String, _
                                ByRef auRects() As RECT, ByVal dScalar As Double)
    If xmlParentElement Is Nothing Then Err.Raise vbObjectError, , "#Null xmlParentElement!"

    Dim dom As MSXML2.DOMDocument60
    Set dom = xmlParentElement.OwnerDocument

    '*  This line break is purely so I can inspect the output easier
    Dim xmlLineBreak As MSXML2.IXMLDOMText
    Set xmlLineBreak = dom.createTextNode(vbNewLine)

    Dim lStarLoop As Long
    For lStarLoop = LBound(auRects) To UBound(auRects)
        Dim uRect As RECT
        uRect = auRects(lStarLoop)

        Dim xmlStar As MSXML2.IXMLDOMElement
        Set xmlStar = dom.createElement("svg:path")
        Call xmlStar.setAttribute("id", sIdPrefix & lStarLoop)

        Call xmlStar.setAttribute("style", sStyle)


        Dim auPoints() As POINTAPI, lPointCount As Long
        Call modUSAFlagSpecification.FivePointedStar(dScalar, 30, uRect.Left, uRect.Top, auPoints, lPointCount)

        Dim uFirstPoint As POINTAPI, uSubsequentPointLoop As POINTAPI
        uFirstPoint = auPoints(0)


        Dim sPath As String
        sPath = "M " & uFirstPoint.x & "," & uFirstPoint.y


        Dim lPointLoop As Long
        For lPointLoop = 1 To 9
            uSubsequentPointLoop = auPoints(lPointLoop)
            sPath = sPath & " L " & uSubsequentPointLoop.x & "," & uSubsequentPointLoop.y
        Next

        Call xmlStar.setAttribute("d", sPath)

        xmlParentElement.appendChild xmlStar
        xmlParentElement.appendChild xmlLineBreak

    Next lStarLoop


End Sub

Private Sub DrawRects(ByVal xmlParentElement As MSXML2.IXMLDOMElement, ByVal sIdPrefix As String, ByVal sStyle As String, ByRef auRects() As RECT)

    If xmlParentElement Is Nothing Then Err.Raise vbObjectError, , "#Null xmlParentElement!"

    Dim dom As MSXML2.DOMDocument60
    Set dom = xmlParentElement.OwnerDocument

    '*  This line break is purely so I can inspect the output easier
    Dim xmlLineBreak As MSXML2.IXMLDOMText
    Set xmlLineBreak = dom.createTextNode(vbNewLine)


    Dim lLoop As Long
    For lLoop = LBound(auRects) To UBound(auRects)
        Dim uRect As RECT
        uRect = auRects(lLoop)

        Dim xmlRect As MSXML2.IXMLDOMElement
        Set xmlRect = dom.createElement("svg:path")
        Call xmlRect.setAttribute("id", sIdPrefix & lLoop)
        Call xmlRect.setAttribute("style", sStyle)

        Dim sPath As String
        sPath = "M " & uRect.Left & "," & uRect.Top
        sPath = sPath & " H " & uRect.Right
        sPath = sPath & " V " & uRect.Bottom
        sPath = sPath & " H " & uRect.Left
        sPath = sPath & " V " & uRect.Top

        Call xmlRect.setAttribute("d", sPath)

        xmlParentElement.appendChild xmlRect
        xmlParentElement.appendChild xmlLineBreak

    Next lLoop


End Sub

Python - SVG - Extract and Parse Path Data from d attribute

Introduction

SVG draw shapes using a path language with commands such as moveto x1,y1; lineto x2,y2; lineto x3,y3; lineto x4,y4 then closepath. All of this is packed into a SVG Path element's d attribute. Python has a library, svg.path to parse these commands.

Background

Ok, so previous post I gave VBA code to extract some shapes from a SVG file converted from a PDF file (in the name of extracting the underlying data point) but whilst VBA has an Xml library it does not have a library to parse the d attribute. So we'll switch into Python. Besides, its Python month on this blog and so I'm meant to be reviewing and introducing useful and interesting Python libraries.

Demonstration of parsing d attribute with svg.path

So install the code (from and admin rights command console) with...

pip install svg.path

Run Python.exe to get into Python environment and enter the following statements (responses are also shown, and indented)

C:\Users\Simon>python
Python 3.6.3 (v3.6.3:2c5fed8, Oct  3 2017, 18:11:49) [MSC v.1900 64 bit (AMD64)] on win32
Type "help", "copyright", "credits" or "license" for more information.
>>> from svg.path import Path,Line,Arc
>>> from svg.path import parse_path
>>> parse_path('m 241.666,133.557 h 2.364 v -25.886 h -2.364 z')
Path(Line(start=(241.666+133.557j), end=(244.03+133.557j)), 
     Line(start=(244.03+133.557j), end=(244.03+107.671j)), 
     Line(start=(244.03+107.671j), end=(241.666+107.671j)), 
     Line(start=(241.666+107.671j), end=(241.666+133.557j)), closed=True)
>>>

So we can see the path being parsed into a sequence of Line objects each with their own start and end co-ordinate pairs.

Python program to process paths

So now we can write some code to extract the height of the rectangle (which represents the underlying data point).

from lxml import etree
from svg.path import Path,Line
from svg.path import parse_path

sFileName = 'C:/Users/Simon/Downloads/pdf_skunkworks/inflation-report-may-2018-page6.svg'

tree=etree.parse(sFileName)

xpath = r"//svg:path[@style='fill:#19518b;fill-opacity:1;fill-rule:nonzero;stroke:none']"

#print (xpath)
bluePaths = tree.xpath(xpath,namespaces={   'svg': "http://www.w3.org/2000/svg"  })

for bluePath in bluePaths:
    parsed=parse_path (bluePath.attrib['d'])
    secondLine = parsed[1]
    print (secondLine.end.imag - secondLine.start.imag) #outputs the height

SVG - VBA - Extracting Path Data

So in the last few posts I have been travelling towards a solution that allows code to scrape data from a Bank Of England PDF. I have got so far as to break up the PDF into separate SVG files. SVG files are easier to work with because they are Xml based.

XPath in VBA

So my first language is VBA and I can quickly give some test code to demonstrate the XPath logic before I delve into a Python solution

Sub TestXml()
    '*Tools->References->Microsoft XML, v6.0
    Dim xml As MSXML2.DOMDocument60
    Set xml = New MSXML2.DOMDocument60
    
    xml.setProperty "SelectionNamespaces", "xmlns:svg='http://www.w3.org/2000/svg'"
    xml.Load "C:\Users\Simon\Downloads\pdf_skunkworks\inflation-report-may-2018-page6.svg"
    
    Debug.Assert xml.parseError.ErrorCode = 0
    
    Dim xmlBluePaths As MSXML2.IXMLDOMNodeList
    Set xmlBluePaths = xml.SelectNodes("//svg:path[@style='fill:#19518b;fill-opacity:1;fill-rule:nonzero;stroke:none']")
    
    Debug.Assert xmlBluePaths.Length = 28
    
    Dim xmlRedPaths As MSXML2.IXMLDOMNodeList
    Set xmlRedPaths = xml.SelectNodes("//svg:path[@style='fill:#a80c3d;fill-opacity:1;fill-rule:nonzero;stroke:none']")
    
    Debug.Assert xmlRedPaths.Length = 28
    
    Dim xmlGreyPaths As MSXML2.IXMLDOMNodeList
    Set xmlGreyPaths = xml.SelectNodes("//svg:path[@style='fill:#a98b6e;fill-opacity:1;fill-rule:nonzero;stroke:none']")
    
    Debug.Assert xmlGreyPaths.Length = 28

    Dim xmlElement As MSXML2.IXMLDOMElement
    Set xmlElement = xmlBluePaths.Item(0)
    
    Debug.Print xmlElement.xml
    Debug.Print xmlElement.getAttribute("d")

End Sub

The next problem however is how to parse the path data which can be found in the d attribute of a path element, here is an example of an element...

<path xmlns="http://www.w3.org/2000/svg" id="path670" style="fill:#19518b;fill-opacity:1;fill-rule:nonzero;stroke:none" d="m 241.666,133.557 h 2.364 v -25.886 h -2.364 z"/>

Within that element one can see the path data packed into the d attribute...

m 241.666,133.557 h 2.364 v -25.886 h -2.364 z

So we need code to parse this path data. But I am not going to give that code in VBA, instead I have a Python library to show you, see next post.

Python - Split PDF into single page SVG files by shelling Inkscape

So if you have been the last few posts you know I want to get data out of a PDF file (in this case a Bank of England Inflation Report). The python library PyPDF2 is good and will split a pdf into separate pages. No doubt, PyPDF2 will do a ton of other stuff to manipulate pdf files. However, I find the pdf file format is difficult to understand which limits how much I want to use a pdf python library. Instead, I have found that Inkscape converts PDFs to SVGs and that we can automate this on the command line.

This means I am in a position to give the latest version of a program which breaks up a PDF file into separate SVG files for each page. (You'll need Inkscape installed). Here it is...

# with thanks to user26294 at Stack Overflow
# https://stackoverflow.com/questions/490195/split-a-multi-page-pdf-file-into-multiple-pdf-files-with-python#answer-490203

from PyPDF2 import PdfFileWriter, PdfFileReader

def DecryptPdf(pdfFileReader,password):
    if pdfFileReader.isEncrypted:
        try:
            pdfFileReader.decrypt(password)
            print ('File decrypted')
        except Exception as e:
            print ('File decryption failed:' + str(e))
    else:
        print ('File not enrypted')

def SuffixFilename(fileName, suffix):
    import os.path
    filePath = os.path.split(fileName)
    
    filePath2 = filePath[1].split('.')
    return  filePath[0] + '\' +filePath2[0] + suffix + '.' + filePath2[1]


def OutputPage(pdfFileNameSrc,pdfFileNamePage, pageNum):
    pdfFileSrc = open(pdfFileNameSrc, "rb")
    pdfFileReaderSrc = PdfFileReader(pdfFileSrc)
    DecryptPdf(pdfFileReaderSrc,'')
    
    pageOutput = PdfFileWriter()
    pageOutput.addPage(pdfFileReaderSrc.getPage(pageNum))

    with open(pdfFileNamePage, "wb") as outputStream:
        pageOutput.write(outputStream)
        print('written page%s' % pageNum)
        outputStream.close 
    pdfFileSrc.close #tidy up
    

def InkscapePdfToSvg(pdfFileName):
    import subprocess 
    svgFileName=pdfFileName.replace(".pdf",".svg")
    
    completed = subprocess.run(['c:/Progra~1/Inkscape/Inkscape.exe',
            '-z', 
            '-f', pdfFileName , 
            '-l', svgFileName])

    return svgFileName


if __name__ == "__main__": 

    pdfFileNameInflation = "C:\Users\Simon\Downloads\pdf_skunkworks\inflation-report-may-2018.pdf"
    pdfFileInflation = open(pdfFileNameInflation, "rb")

    pdfFileReaderInflation = PdfFileReader(pdfFileInflation)

    DecryptPdf(pdfFileReaderInflation,'')
    pageCount = pdfFileReaderInflation.numPages

    for i in range(pageCount):
        pdfFileNamePage=SuffixFilename(pdfFileNameInflation,"-page%s" % i)
        
        OutputPage(pdfFileNameInflation,pdfFileNamePage,i)
        print (InkscapePdfToSvg(pdfFileNamePage))