Transformation. Apply to Duplicate
kuterma2 / 15.09.2010, 13:21/00:41
Форум:
Парни, одолела меня необходимость постоянно тыкать в кнопку "Apply " на панели Transformation... Галочки ставить там ещё к тому-же...
Часто приходится дублировать объекты вправо или влево... вверх или вниз... Хотелось бы макрос замутить на эту тему. Смысл такой - нажимаешь на гор.клавишу и справа (или слева или сверху или снизу) дублируется этот объект...
Попробовал тупо записать сам - не выходит...
Тута нужен спец... Ежели кто может - может кто поможет?!.. а?..
Думаю такой макрос пригодится не только мне...
Я думаю что что-то подобное уже точно есть, поищи.
Я бесплатно точно не буду писать, просто некогда.
Да в том-то и дело - искал - ничего путного не накопал...
А макрос как мне кажется должен быть прост...
ну прост/не прост а делать я его всё равно не буду, тем более бесплатно. Время — деньги!
давно написал такой макрос, кому нужно - пользуйтесь
только подправьте для своих нужд строку c .Move
(поменяйте функцию на .SizeWidth и параметры местами для копирования влево/вправо)
sub Clone_Down
Dim srS, srC As ShapeRange
Set srS = ActiveSelectionRange
With srS
Set srC = .Duplicate
.Move 0#, 0 - .SizeHeight ' копируем снизу от исходного
.OrderForwardOne
End With
End Sub
shark, спасибо, попробую поковыряться.
Поковырялся - вверх-вниз - сделал, а вправо-влево - никак... подставляю - SizeWidth - а он копирует вниз с каким-то отступом... (простите, парни, если напрягаю, но я лох в этом деле полный...)
Sub Dup_vniz()
Dim srS, srC As ShapeRange
Set srS = ActiveSelectionRange
With srS
Set srC = .Duplicate
.Move 0#, 0 - .SizeHeight ' копируем снизу от исходного
.OrderForwardOne
End With
End Sub
Sub Dup_Vverx()
Dim srS, srC As ShapeRange
Set srS = ActiveSelectionRange
With srS
Set srC = .Duplicate
.Move 0#, 0 + .SizeHeight ' копируем сверху от исходного
.OrderForwardOne
End With
End Sub
Sub Dup_Vlevo()
Dim srS, srC As ShapeRange
Set srS = ActiveSelectionRange
With srS
Set srC = .Duplicate
.Move 0#, 0 - .SizeWidth ' копируем -- от исходного
.OrderForwardOne
End With
End Sub
Надо SizeWidth ставить на первое место в методе Move([DeltaX As Double], [DeltaY As Double])
Но я бы наверное сделал бы примерно так
Sub DupRight()
If ActiveSelectionRange.Count = 0 Then
MsgBox "Ничего не выделено"
Exit Sub
Else
ActiveSelectionRange.Duplicate(ActiveSelectionRange.SizeWidth, 0).OrderForwardOne
End If
End Sub
shark, dEar, спасибо вам, парни.
Да только моих познаний (ну не знаю я Визуала Бейсика... совсеммм) не хватает чтоб довести ваши макросы до ума...
Если кто может - напишите поподробнее для чайника - куда чего точно писать.
- твой метод работает, но выделение остается на первом объекте - а мне надо, чтоб был выделен дубликат был...
shark, влево - вправо работает - а вверх - вниз бы вот ещё....
Парни, простите, что занимаюсь попрошайничеством, но... как-то "закантило" меня прям на это дело - хочется крепко...
kuterma2, ты просто повнимательнее читай
.Move 0#, 0 - .SizeHeight ' копируем вниз
.Move 0#, .SizeHeight ' ... вверх
.Move 0 - .SizeWidth, 0# '... влево, (меняем параметры местами и функцию на SizeWidth)
.Move .SizeWidth, 0# ' ...вправо
shark, Преогромное спасибо, друг! Благодарю за разжёвывание! Всё работает как часы - быстро да ладно! Назначил гор. клавиши - и теперь всё - просто песня!
Прицепляю готовый GMS - назвал SS_Duplicator - может ещё кому-то надо.
Удобно пользоваться если настроить гор.клавиши. Я настроил так: Ctrl+Alt+Shift+стрелки(вверх, вниз, влево-вправо соответственно)
Спасибо за макрос. Решил переделать его под свои нужды, сделал с интерфейсом и с возможностью отклонения позиции по миллиметрам, вводить в чёрном поле(вроде понятно написал :) ) Справа показан размер объекта, чтобы его обновить нужно нажать на кнопку "Размер", в принципе эти поля не нужны, для наглядности и только. Вопрос возник: как сделать так, чтобы размер вписывался автоматически после выделения объекта, а не так как сейчас реализовано(после нажатия на кнопку)?
Страницы