шестеренка

wardogs / 08.10.2013, 22:10
Форум: 
Макросы и скрипты

может поможете сделать лучше
сори я не программер, все по f1
Sub Macro1()
Dim s1 As Shape
Dim s2 As Shape
Set a1 = ActiveLayer.Shapes(1)
Set a2 = ActiveLayer.Shapes(2)
b1 = a1.RotationCenterX
b2 = a1.RotationCenterY
c1 = a2.RotationCenterX
c2 = a2.RotationCenterY
For i = 1 To 360 Step 0.5
Set a3 = a1.Trim(a2, True, False)
a3.RotateEx 0.5, c1, c2
a1.RotateEx -0.5, b1, b2
Set a2 = a3
Next