Макрос для построения случайных фигур в CorelDRAW написан на VBA

Visual Basic for Applications (VBA, Visual Basic для приложений) — немного упрощённая реализация языка программирования Visual Basic, встроенная в CorelDRAW и некоторые другие программы.  VBA является интерпретируемым языком. Как и следует из его названия, VBA близок к Visual Basic. VBA, будучи языком, построенным на COM, позволяет использовать все доступные в операционной системе COM объекты и компоненты ActiveX.
С помощь VBA можно значительно ускорить выполнение некоторых операций в CorelDRAW. 
Отмечу, что я не являюсь профессиональным программистом, скорее я оптимизатор рутинных процессов. Поэтому если мой код покажется вам не оптимальным, прошу камнями не кидаться
В данном уроке, показывается как построить множество случайных фигур (эллипсов, прямоугольников, звезд) со случайными заливками и обводками, имеющих случайную прозрачность.

Форма имеет следующей вид

Private Sub CommandButton1_Click()
Dim i, j, n1, n2, n3, n4 As Integer
Dim x, h, w, z, z2, z0
Dim nap1, nap2, nap3, nap4, curv As Shape

'Динамические переменные
Dim s() As Shape 'прямоугольники
Dim e() As Shape 'эллипсы
Dim star() As Shape 'звезды
Dim doc1 As Document
 
Set doc1 = CreateDocument()
ActiveDocument.Unit = cdrMillimeter
ActiveDocument.MasterPage.SetSize UserForm4.TextBox6, UserForm4.TextBox7

'Направляющие: 1-левая, 2-правая, 3-нижняя, 4-верхняя
If UserForm4.CheckBox04.Value = True Then Set nap4 = ActiveDocument.MasterPage.GuidesLayer.CreateGuideAngle(0, UserForm4.TextBox7 - UserForm4.TextBox8, 0)
If UserForm4.CheckBox01.Value = True Then Set nap1 = ActiveDocument.MasterPage.GuidesLayer.CreateGuideAngle(UserForm4.TextBox8, 0, 90#)
If UserForm4.CheckBox03.Value = True Then Set nap3 = ActiveDocument.MasterPage.GuidesLayer.CreateGuideAngle(0, UserForm4.TextBox8, 0)
If UserForm4.CheckBox02.Value = True Then Set nap2 = ActiveDocument.MasterPage.GuidesLayer.CreateGuideAngle(UserForm4.TextBox6 - UserForm4.TextBox8, 0, 90#)

n1 = UserForm4.TextBox1
n2 = UserForm4.TextBox2
n3 = UserForm4.TextBox9
n4 = UserForm4.TextBox12
w = ActiveDocument.ActivePage.SizeHeight
h = ActiveDocument.ActivePage.SizeWidth

'Создание массива эллипса
Randomize
ReDim e(n2)
For j = 1 To n2
x = Rnd * UserForm4.TextBox4
Set e(j) = ActiveLayer.CreateEllipse2(Rnd * h, Rnd * w, Rnd)
e(j).SizeHeight = x
e(j).SizeWidth = x
e(j).Outline.SetProperties Color:=CreateCMYKColor(Rnd * 50, Rnd * 100, Rnd * 100, Rnd * 40)
e(j).Outline.SetProperties Width:=Rnd * UserForm4.TextBox5
If UserForm4.CheckBox5.Value = False Then e(j).Fill.ApplyNoFill Else e(j).Fill.UniformColor.CMYKAssign Rnd * 40, Rnd * 60, Rnd * 60, Rnd * 10
If UserForm4.CheckBox6.Value = True Then e(j).Transparency.ApplyUniformTransparency 70 * Rnd
ActiveDocument.AddToSelection e(j)
Next j

'Создание массива прямоугольников
ReDim s(n1)
For i = 1 To n1
x = Rnd * UserForm4.TextBox3
Set s(i) = ActiveLayer.CreateRectangle(Rnd * h, Rnd * w, Rnd * h, Rnd * w)
s(i).SizeHeight = x
s(i).SizeWidth = x
s(i).Fill.ApplyNoFill
s(i).Outline.SetProperties Color:=CreateCMYKColor(Rnd * 50, Rnd * 100, Rnd * 100, Rnd * 10)
s(i).Outline.SetProperties Width:=Rnd * UserForm4.TextBox5
s(i).Rotate Rnd * 45
If UserForm4.CheckBox5.Value = False Then s(i).Fill.ApplyNoFill Else s(i).Fill.UniformColor.CMYKAssign Rnd * 30, Rnd * 80, Rnd * 80, Rnd * 10
If UserForm4.CheckBox6.Value = True Then s(i).Transparency.ApplyUniformTransparency 70 * Rnd
ActiveDocument.AddToSelection s(i)
Next i

'Создание массива звезд
ReDim star(n3)
For i = 1 To n3
x = Rnd * UserForm4.TextBox11
z0 = Int(Rnd * TextBox10)
If z0 < 3 Then z0 = 12
Set star(i) = ActiveLayer.CreatePolygon(Rnd * h, Rnd * w, Rnd * h, Rnd * w, z0, 1, 1, True, Int(Rnd * 50), 50 + Int(Rnd * 50))
star(i).PositionX = Rnd * h
star(i).PositionY = Rnd * w
star(i).SizeHeight = x
star(i).SizeWidth = x
star(i).Fill.ApplyNoFill
star(i).Outline.SetProperties Color:=CreateCMYKColor(Rnd * 50, Rnd * 100, Rnd * 100, Rnd * 10)
star(i).Outline.SetProperties Width:=Rnd * UserForm4.TextBox5
If UserForm4.CheckBox5.Value = False Then star(i).Fill.ApplyNoFill Else star(i).Fill.UniformColor.CMYKAssign Rnd * 50, Rnd * 20, Rnd * 90, Rnd * 10
If UserForm4.CheckBox6.Value = True Then star(i).Transparency.ApplyUniformTransparency 70 * Rnd
Next i

'создание ломанной линии
Set curv = ActiveLayer.CreateLineSegment(Rnd * h, Rnd * w, Rnd * h, Rnd * w)
curv.Outline.SetProperties Width:=Rnd * UserForm4.TextBox5
Dim crv As Curve
Set crv = ActiveDocument.CreateCurve()
With crv.CreateSubPath(Rnd * h, Rnd * w)
For i = 1 To n4
.AppendLineSegment Rnd * h, Rnd * w
Next i
End With
curv.Curve.CopyAssign crv

'группировка всех созданных объектов и помещение в контейнер
ActiveDocument.AddToSelection curv
For i = 1 To n1 - 1
ActiveDocument.AddToSelection s(i), s(i + 1)
Next i
For i = 1 To n2 - 1
ActiveDocument.AddToSelection e(i), e(i + 1)
Next i
For i = 1 To n3 - 1
ActiveDocument.AddToSelection star(i), star(i + 1)
Next i

Dim group_figur As Shape
Set group_figur = ActiveSelection.Group
Dim clip As Shape
Set clip = ActiveLayer.CreateRectangle(0, w, h, 0)
clip.Fill.UniformColor.CMYKAssign 0, 0, 100, 0
clip.Outline.SetProperties Width:=0
group_figur.AddToPowerClip clip
End Sub


Результат работы макроса (по 300 объектов, максимальный размер объекта 100 мм):