Макрос массовый поворот

[dizzy]

идея для макроса

суть в том чтобы макрос переворачивал некое количество выделенных обьектов не относительно общего центра, а каждый обьект вокруг своего центра. по моему часто нужная функция - когда надо перевернуть обьекты не меняя их позиции

просто идея...

Sub povorot()
On Error GoTo myEnd
Dim A As Double, myShape As Shape
A = CDbl(InputBox("Введите угол поворота"))
'Ну или если лень вбивать угол, можно подравнять под меченый объект _
для этого предыдущую строчку меняете на следующую
'A = mySh.RotationAngle
For Each myShape In ActiveSelection.Shapes
    myShape.RotationAngle = A
Next myShape

Для тех кто не в теме... Просто копируете этот код > Alt + F11 > Слева в верхнем столбце найдите мой набор Шэйпинг (модуль Shapes его откройте если скачали и установили) > и туды вставьте куды-нить в самый низ... Ей богу лень прикреплять файлы!

 

[inTurisT]

Ответ: Макрос массовый поворот

спасибо! прям как заказывал =)

 

[lev]

Ответ: Макрос массовый поворот

вариации:
http://oberonplace.com/draw/drawscripts/transformsh.htm
http://kir-arts.narod.ru/Transform.html

 

[xplight]

Ответ: Макрос массовый поворот

куда там что вставить %)
-

Compile error: lable not defined
Sub povorot()

 

[dizzy]

Ответ: Макрос массовый поворот

куда там что вставить %)
-

Все верно... Там просто одной строки не хватает (и как это я ее пропустил)...

Sub povorot() 
On Error GoTo myEnd 
Dim A As Double, myShape As Shape 
A = CDbl(InputBox("Введите угол поворота")) 
'Ну или если лень вбивать угол, можно подравнять под меченый объект _ 
для этого предыдущую строчку меняете на следующую 
'A = mySh.RotationAngle 
For Each myShape In ActiveSelection.Shapes 
    myShape.RotationAngle = A 
myEnd: 'Вот этой и не хватало:(
Next myShape

 

[dizzy]

Ответ: Макрос массовый поворот

Доработал свой наборчик шэйпинг... Терь при вызове открывается симпатичная менюшка (наподобие как у адобов, маленькая такая, компактная), где есть кнопка поворота выделеных объектов...

Юзайте!