Reputation: 366
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:
Inserting the same file using IguanaTex's VBA code leads to the following distorted output, where the "a" and "s" letters are vertically elongated:
The VBA code essentially:
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:
Upvotes: 1
Views: 711
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:
I think it likely that if you test with more real-world files, you'll get better results.
Upvotes: 0