leilu
leilu

Reputation: 366

Distortion when ungrouping inserted EMF file into Powerpoint

Background: I am the developer of IguanaTex, a Powerpoint add-in to include LaTeX displays in Powerpoint. IguanaTex can generate vector graphics displays (Powerpoint Shapes, typically Freeforms) by inserting EMF files into a slide, ungrouping them, and doing some clean up (removing extra shapes, further ungrouping, removing lines, ...). These EMF files are typically generated using an external engine (Tex2img) either from LaTeX or from a PDF file that a user wants to convert into an editable shape (not really related to LaTeX, but the whole code base is there to offer that feature, so I put it in).

Issue: I have recently noticed sporadic issues when programmatically ungrouping EMF files, while ungrouping the same file via the GUI does not lead to errors. I have confirmed this occurs on two Windows 10 machines running either Office 2010, Office 2016, or Office 365.

Let's say we insert this EMF file and obtain the following Picture object in Powerpoint:

EMF file inserted with Powerpoint GUI

Inserting the same file using IguanaTex's VBA code leads to the following distorted output, where the "a" and "s" letters are vertically elongated:

EMF file inserted with VBA

The VBA code essentially:

  1. Adds the EMF file as a shape using the Shapes.AddPicture method
  2. Ungroups the shape using the Shape.Ungroup method into a ShapeRange (equivalent to Ungrouping an inserted EMF file in the GUI)
  3. Cleans up by doing one more Ungroup, removing the extra shapes (in our case 1 Autoshape and 1 Rectangle), selecting the group (or Freeform if there is only one) that's at the top, removing the remaining Rectangle, and setting each shape's Outline to be invisible.

Running the code in Debug mode, I could pinpoint the distortion occurring at the first Shape.Ungroup step, which should again in theory be equivalent to doing Shift+Ctrl+G in the GUI (and pressing Yes, as the GUI asks for confirmation when ungrouping EMF files). Note that the distortion still happens when I step over the Ungrouping line.

What is particularly frustrating with this bug, is that if I place in a macro essentially the exact same VBA code that handles Steps 2 and 3 above (everything except inserting the file), then stops the add-in code after the file insertion in Step 1 and run the rest using the macro, that usually doesn't lead to any distortion. I say usually, because this bug is not 100% reproducible: it will sometimes occur, and sometimes it won't. The most reliable way that I found to reproduce it has been to insert the EMF file linked above.

So there doesn't seem to be a particular issue with the code itself, but with the way Powerpoint runs it. Could there be some race condition? Note that I have also noticed that IguanaTex sometimes raises an error in random locations when grouping/ungrouping shapes, and re-running generally solves the issue, which could also point at some race condition. That however seems unlikely here because the distortion issue still occurs when stepping over the code in debug mode.

My questions are thus: does anyone have a clue what is going on, and how can I fix this?

Below is the macro mentioned earlier:

Public Sub Emftoshape()
    Dim ConvertLines As Boolean
    ConvertLines = False
    Dim Sel As Selection
    Set Sel = Application.ActiveWindow.Selection
    ' Get current slide, it will be used to group ranges
    Dim sld As Slide
    Dim SlideIndex As Long
    SlideIndex = ActiveWindow.View.Slide.SlideIndex
    Set sld = ActivePresentation.Slides(SlideIndex)

    Dim shp As Shape
    Set shp = Sel.ShapeRange(1)
    ' Convert EMF image to object
    Dim Shr As ShapeRange
    Set Shr = shp.Ungroup
    Set Shr = Shr.Ungroup
    ' Clean up
    Shr.Item(1).Delete
    Shr.Item(2).Delete
    Dim newShape As Shape
    If Shr(3).GroupItems.count > 2 Then
        Set newShape = Shr(3)
    Else ' only a single freeform, so not a group
        Set newShape = Shr(3).GroupItems(2)
    End If
    Shr(3).GroupItems(1).Delete

    If newShape.Type = msoGroup Then
    
        Dim arr_group() As Variant
        arr_group = GetAllShapesInGroup(newShape)
        Call FullyUngroupShape(newShape)
        Set newShape = sld.Shapes.Range(arr_group).Group
        
        Dim emf_arr() As Variant ' gather all shapes to be regrouped later on
        j_emf = 0
        Dim delete_arr() As Variant ' gather all shapes to be deleted later on
        j_delete = 0
        Dim s As Shape
        For Each s In newShape.GroupItems
            j_emf = j_emf + 1
            ReDim Preserve emf_arr(1 To j_emf)
            If s.Type = msoLine Then
                If ConvertLines And (s.Height > 0 Or s.Width > 0) Then
                    emf_arr(j_emf) = LineToFreeform(s).name
                    j_delete = j_delete + 1
                    ReDim Preserve delete_arr(1 To j_delete)
                    delete_arr(j_delete) = s.name
                Else
                    emf_arr(j_emf) = s.name
                End If
            Else
                emf_arr(j_emf) = s.name
                If s.Fill.Visible = msoTrue Then
                s.Line.Visible = msoFalse
                Else
                s.Line.Visible = msoTrue
                
                End If
            End If
        Next
        newShape.Ungroup
        If j_delete > 0 Then
            sld.Shapes.Range(delete_arr).Delete
        End If
        Set newShape = sld.Shapes.Range(emf_arr).Group
    
    Else
        If newShape.Type = msoLine Then
            newShapeName = LineToFreeform(newShape).name
            newShape.Delete
            Set newShape = sld.Shapes(newShapeName)
        Else
            newShape.Line.Visible = msoFalse
        End If
    End If
    newShape.LockAspectRatio = msoTrue
End Sub

Private Sub FullyUngroupShape(newShape As Shape)
    Dim Shr As ShapeRange
    Dim s As Shape
    If newShape.Type = msoGroup Then
        Set Shr = newShape.Ungroup
        For i = 1 To Shr.count
            Set s = Shr.Item(i)
            If s.Type = msoGroup Then
                Call FullyUngroupShape(s)
            End If
        Next
    End If
End Sub

Private Function GetAllShapesInGroup(newShape As Shape) As Variant
    Dim arr() As Variant
    Dim j As Long
    Dim s As Shape
    For Each s In newShape.GroupItems
            j = j + 1
            ReDim Preserve arr(1 To j)
            arr(j) = s.name
    Next
    GetAllShapesInGroup = arr
End Function

Private Function LineToFreeform(s As Shape) As Shape
    t = s.Line.Weight
    Dim ApplyTransform As Boolean
    ApplyTransform = True
    
    Dim bHflip As Boolean
    Dim bVflip As Boolean
    Dim nBegin As Long
    Dim nEnd As Long
    Dim aC(1 To 4, 1 To 2) As Double
    
    With s
        aC(1, 1) = .Left:           aC(1, 2) = .Top
        aC(2, 1) = .Left + .Width:  aC(2, 2) = .Top
        aC(3, 1) = .Left:           aC(3, 2) = .Top + .Height
        aC(4, 1) = .Left + .Width:  aC(4, 2) = .Top + .Height
    
        bHflip = .HorizontalFlip
        bVflip = .VerticalFlip
    End With
    
    If bHflip = bVflip Then
        If bVflip = False Then
            ' down to right -- South-East
            nBegin = 1: nEnd = 4
        Else
            ' up to left -- North-West
            nBegin = 4: nEnd = 1
        End If
    ElseIf bHflip = False Then
        ' up to right -- North-East
        nBegin = 3: nEnd = 2
    Else
        ' down to left -- South-West
        nBegin = 2: nEnd = 3
    End If
    xs = aC(nBegin, 1)
    ys = aC(nBegin, 2)
    xe = aC(nEnd, 1)
    ye = aC(nEnd, 2)
    
    ' Get unit vector in orthogonal direction
    xd = xe - xs
    yd = ye - ys
    
    s_length = Sqr(xd * xd + yd * yd)
    If s_length > 0 Then
    n_x = -yd / s_length
    n_y = xd / s_length
    Else
    n_x = 0
    n_y = 0
    End If
    
    x1 = xs + n_x * t / 2
    y1 = ys + n_y * t / 2
    x2 = xe + n_x * t / 2
    y2 = ye + n_y * t / 2
    x3 = xe - n_x * t / 2
    y3 = ye - n_y * t / 2
    x4 = xs - n_x * t / 2
    y4 = ys - n_y * t / 2
        
    'End If
    
    
    If ApplyTransform Then
        Dim builder As FreeformBuilder
        Set builder = ActiveWindow.Selection.SlideRange(1).Shapes.BuildFreeform(msoEditingCorner, x1, y1)
        builder.AddNodes msoSegmentLine, msoEditingAuto, x2, y2
        builder.AddNodes msoSegmentLine, msoEditingAuto, x3, y3
        builder.AddNodes msoSegmentLine, msoEditingAuto, x4, y4
        builder.AddNodes msoSegmentLine, msoEditingAuto, x1, y1
        Dim oSh As Shape
        Set oSh = builder.ConvertToShape
        oSh.Fill.ForeColor = s.Line.ForeColor
        oSh.Fill.Visible = msoTrue
        oSh.Line.Visible = msoFalse
        oSh.Rotation = s.Rotation
        Set LineToFreeform = oSh
    Else
        Set LineToFreeform = s
    End If
End Function

Edit: Here is a visual comparison between several ways to insert the EMF file linked above or a modified version of it, where colors are added for illustration:

  1. The EMF file cleaned by John Korchok to remove a clipping mask and a rectangle, and ungrouped with the GUI. Apart from being distorted (the curves are not smooth, and the "a" and "s" are taller than in the original file), the file indeed behaves the same when ungrouping with VBA of with the GUI. That's unfortunately not a viable solution for my problem.
  2. The EMF file ungrouped using VBA (rectangles/autoshapes are normally removed by IguanaTex). "a" and "s" are clearly taller, as can be seen thanks to the horizontal line added as reference.
  3. The EMF file ungrouped with the GUI. This is the desired outcome.
  4. The corresponding PNG file (obtained by converting from PDF using Ghostscript) whose aspect ratio was modified to match the size of the inserted EMF file. Because I trust the PDF/PNG output more, IguanaTex has an option to "vectorize" a PNG display which resizes the ungrouped EMF to match the PNG's size.

Visual comparison of various versions of the display "masks" inserted into Powerpoint

Upvotes: 1

Views: 711

Answers (1)

John Korchok
John Korchok

Reputation: 4913

When you get variable and unpredictable results, it makes it likely that it's some property of the source file causing the issue. I opened it in both Adobe Illustrator and InkScape. Your sample file has problems:

  1. The text size is really small, about 2.5 points. This means even slight errors will have large visual results.
  2. The top of the k is definitely clipped by the edge of the EMF. I believe the m may be clipped on the left, but the image is so small I can't zoom in enough to see. Since those are the two letters that get resized, that may be a source of the problem.
  3. Your EMF also includes a rectangle that is 3.91" wide and 1.06" tall, enormous by comparison with the tiny text. The upper left corner of this rectangle is at the same position as the rectangle masking the text.

I think it likely that if you test with more real-world files, you'll get better results.

Upvotes: 0

Related Questions