Hello all, it's been quite a while.
At my workplace we have been using CorelDRAW 2018 with several complex custom-built VBA macros made by me. This involves nesting, object manipulation, large scale duplication and several other things that tend to take quite while.
I remember seeing somewhere on the website that the performance in 2020 has been drastically improved and decided to put it to a test. Just making a simple macro where 10000 objects are created and then rotated.
Pure creation was about 5 times faster and creation, then rotation about 2 times faster. Of course, I used this excellent optimization advice from GDG_John.
Now my question is - does the 2020 version have any other optimization tools for VBA macros?
Do you use VirtualShapes, VirtualLayers etc?
Sub CreateManyObjects() Dim Doc As Document Dim n As Long Dim sRect As Shape Dim sr As New ShapeRange
Set Doc = CreateDocument ' Create 10000 rectangles For n = 1 To 10000 Set sRect = Doc.TreeManager.VirtualLayer.CreateRectangle2(Rnd() * 8, Rnd() * 11, Rnd() * 4, Rnd() * 5) sRect.Fill.UniformColor.RGBAssign Rnd() * 255, Rnd() * 255, Rnd() * 255 sRect.Rotate Rnd() * 360 sr.Add sRect Next n ' Log the transaction Set sr = Doc.LogCreateShapeRange(sr) ' Now sr is a real shape range and manipulating it at this point will case additional transactions to be loggedEnd Sub
Just wanted to add that I made a small comparison between virtual shapes and the usual based on your example and the Virtual shapes approach was almost exactly twice as fast. So I'll definitely have to look into trying to adapt the method some more.
Still wondering if there are any new methods in 2020 for further improvement.
Here's the test version, btw:
Sub CreateManyObjects() Dim Doc As Document Dim n As Long Dim sRect As Shape Dim sr As New ShapeRange Dim T As Single T = Timer Dim answer As Integer answer = MsgBox("Use virtual objects?", vbQuestion + vbYesNo + vbDefaultButton2, "Choose the optimisation type") If answer = vbYes Then Set Doc = CreateDocument ' Create 10000 rectangles For n = 1 To 10000 Set sRect = Doc.TreeManager.VirtualLayer.CreateRectangle2(Rnd() * 8, Rnd() * 11, Rnd() * 4, Rnd() * 5) sRect.Fill.UniformColor.RGBAssign Rnd() * 255, Rnd() * 255, Rnd() * 255 sRect.Rotate Rnd() * 360 sr.Add sRect Next n ' Log the transaction Set sr = Doc.LogCreateShapeRange(sr) ' Now sr is a real shape range and manipulating it at this point will case additional transactions to be logged MsgBox Timer - T ActiveWindow.Refresh Else Optimization = True EventsEnabled = False ActiveDocument.SaveSettings Set Doc = CreateDocument ' Create 10000 rectangles For n = 1 To 10000 Set sRect = ActiveLayer.CreateRectangle2(Rnd() * 8, Rnd() * 11, Rnd() * 4, Rnd() * 5) sRect.Fill.UniformColor.RGBAssign Rnd() * 255, Rnd() * 255, Rnd() * 255 sRect.Rotate Rnd() * 360 Next n MsgBox Timer - T ActiveDocument.RestoreSettings EventsEnabled = True Optimization = False ActiveWindow.Refresh End If End Sub
You are measuring the time for the answer. Set Timer after the answer. You can combine both methods.
Sub CreateManyObjects() Dim Doc As Document Dim n As Long Dim sRect As Shape Dim sr As New ShapeRange Dim sr_c As New ShapeRange
Dim T As Single, t1 As Single, t2 As Single, t3 As Single
T = Timer 'virtual Set Doc = CreateDocument ' Create 10000 rectangles For n = 1 To 10000 Set sRect = Doc.TreeManager.VirtualLayer.CreateRectangle2(Rnd() * 8, Rnd() * 11, Rnd() * 4, Rnd() * 5) sRect.Fill.UniformColor.RGBAssign Rnd() * 255, Rnd() * 255, Rnd() * 255 sRect.Rotate Rnd() * 360 sr.Add sRect Next n ' Log the transaction Set sr = Doc.LogCreateShapeRange(sr) ' Now sr is a real shape range and manipulating it at this point will case additional transactions to be logged
Refresh
t1 = Timer - T T = Timer 'optimizations
Optimization = True EventsEnabled = False ActiveDocument.SaveSettings
Set Doc = CreateDocument ' Create 10000 rectangles For n = 1 To 10000 Set sRect = ActiveLayer.CreateRectangle2(Rnd() * 8, Rnd() * 11, Rnd() * 4, Rnd() * 5) sRect.Fill.UniformColor.RGBAssign Rnd() * 255, Rnd() * 255, Rnd() * 255 sRect.Rotate Rnd() * 360 Next n
ActiveDocument.RestoreSettings EventsEnabled = True Optimization = False Refresh
t2 = Timer - T T = Timer
'combo Optimization = True EventsEnabled = False ActiveDocument.SaveSettings
Set Doc = CreateDocument ' Create 10000 rectangles For n = 1 To 10000 Set sRect = Doc.TreeManager.VirtualLayer.CreateRectangle2(Rnd() * 8, Rnd() * 11, Rnd() * 4, Rnd() * 5) sRect.Fill.UniformColor.RGBAssign Rnd() * 255, Rnd() * 255, Rnd() * 255 sRect.Rotate Rnd() * 360 sr_c.Add sRect Next n ' Log the transaction Set sr_c = Doc.LogCreateShapeRange(sr_c)
ActiveDocument.RestoreSettings EventsEnabled = True Optimization = False Refresh t3 = Timer - T
MsgBox "virtual - " & t1 & vbCrLf & "Optimizations - " & t2 & vbCrLf & "Combo - " & t3End Sub
lev said:You are measuring the time for the answer. Set Timer after the answer. You can combine both methods.
Hmm, in my case you pick either one of the approaches and then the answer pop up shows just the time passed for that approach. As far as I can tell that worked just fine - I get the same numbers as your version. But direct comparison and redraw time is a nice touch, though.
Anyhow, I'll need to build comparisons for something more complex and see how much it takes to have virtual shapes work with that is necessary. But it certainly looks promising, thanks again.
Your code:
T = Timer 'you get the initial time
Dim answer As Integer
answer = MsgBox("Use virtual objects?",... 'computer waits for your answer, time goes on
...
MsgBox Timer - T' time for the answer is included
test it on 1 rectangle instead of 10000
Ah, got it. I just usually clock so fast there's no real difference.
t1 = Timer - T
"Refresh" may take some time too