Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Поворот объекта, в зависимости от поворота другого объекта. - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поворот объекта, в зависимости от поворота другого объекта. (Макросы/Sub)
Поворот объекта, в зависимости от поворота другого объекта.
Glass4217 Дата: Воскресенье, 27.01.2019, 07:33 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Здравствуйте, друзья.
Помогите разобраться с тригонометрической задачей.

Есть макрос, поворачивающий фигуру по направлению к некоему объекту.
Фигура представляет собой круг, стрелку и ромб.
Круг не поворачивается вообще. Но это и ни к чему, поскольку он и так круглый со всех сторон.
Стрелка поворачивается, по оси вращения проходящей через ее середину и центр круга.
А вот ромб, который тоже входит в группу - находится не посередине, а на окончании стрелки.

Как этот ромб повернуть, вместе со стрелкой, чтобы он по прежнему оставался на конце стрелки ?
К сообщению приложен файл: 1695394.xls(73.0 Kb)
 
Ответить
СообщениеЗдравствуйте, друзья.
Помогите разобраться с тригонометрической задачей.

Есть макрос, поворачивающий фигуру по направлению к некоему объекту.
Фигура представляет собой круг, стрелку и ромб.
Круг не поворачивается вообще. Но это и ни к чему, поскольку он и так круглый со всех сторон.
Стрелка поворачивается, по оси вращения проходящей через ее середину и центр круга.
А вот ромб, который тоже входит в группу - находится не посередине, а на окончании стрелки.

Как этот ромб повернуть, вместе со стрелкой, чтобы он по прежнему оставался на конце стрелки ?

Автор - Glass4217
Дата добавления - 27.01.2019 в 07:33
bmv98rus Дата: Воскресенье, 27.01.2019, 09:32 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 2030
Репутация: 321 ±
Замечаний: 20% ±

Excel 2013/2016
1. Ищите и применяйте для смещения ромба формулу поворота точки вокруг другой, в данном случае центр стрелки. Рассчитать его надеюсь сможете.
2. Ну и поворот ромба вокруг своего центра на нужный Вам угол.

При желании можно всю группу сразу вращать, но тогда надо рассчитать компенсирующее смещение для центра круга или стрелки и после поворода передвинуть всю группу.


Замечательный медведь, процентов на 20.

Сообщение отредактировал bmv98rus - Воскресенье, 27.01.2019, 09:42
 
Ответить
Сообщение1. Ищите и применяйте для смещения ромба формулу поворота точки вокруг другой, в данном случае центр стрелки. Рассчитать его надеюсь сможете.
2. Ну и поворот ромба вокруг своего центра на нужный Вам угол.

При желании можно всю группу сразу вращать, но тогда надо рассчитать компенсирующее смещение для центра круга или стрелки и после поворода передвинуть всю группу.

Автор - bmv98rus
Дата добавления - 27.01.2019 в 09:32
doober Дата: Воскресенье, 27.01.2019, 14:57 | Сообщение № 3
Группа: Друзья
Ранг: Ветеран
Сообщений: 547
Репутация: 236 ±
Замечаний: 0% ±

Excel 2007
поскольку он и так круглый со всех сторон.

hands
Интересно, сколько у круга сторон?


 
Ответить
Сообщение
поскольку он и так круглый со всех сторон.

hands
Интересно, сколько у круга сторон?

Автор - doober
Дата добавления - 27.01.2019 в 14:57
Glass4217 Дата: Воскресенье, 27.01.2019, 18:17 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
bmv98rus, вот ровным счетом об этом я и спрашивал.
Как эту фигуру повернуть, вместе со стрелкой, чтобы она по прежнему оставалась на конце стрелки ?
 
Ответить
Сообщениеbmv98rus, вот ровным счетом об этом я и спрашивал.
Как эту фигуру повернуть, вместе со стрелкой, чтобы она по прежнему оставалась на конце стрелки ?

Автор - Glass4217
Дата добавления - 27.01.2019 в 18:17
Pelena Дата: Воскресенье, 27.01.2019, 20:05 | Сообщение № 5
Группа: Админы
Ранг: Местный житель
Сообщений: 13879
Репутация: 3044 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Поворачивайте всю группу, а не стрелку
К сообщению приложен файл: 1970103.xls(54.0 Kb)


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеПоворачивайте всю группу, а не стрелку

Автор - Pelena
Дата добавления - 27.01.2019 в 20:05
Glass4217 Дата: Воскресенье, 27.01.2019, 20:35 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, подскажите - как в вашем макросе выбрать ось вращения - не центру группы, а по центру зеленого круга ?

Потому что сейчас вращение происходит - по центру всей группы и этот круг сейчас смещается.


Сообщение отредактировал Glass4217 - Воскресенье, 27.01.2019, 20:37
 
Ответить
СообщениеPelena, подскажите - как в вашем макросе выбрать ось вращения - не центру группы, а по центру зеленого круга ?

Потому что сейчас вращение происходит - по центру всей группы и этот круг сейчас смещается.

Автор - Glass4217
Дата добавления - 27.01.2019 в 20:35
Pelena Дата: Воскресенье, 27.01.2019, 21:38 | Сообщение № 7
Группа: Админы
Ранг: Местный житель
Сообщений: 13879
Репутация: 3044 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Так подойдёт?
К сообщению приложен файл: 7564653.xls(57.5 Kb)


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеТак подойдёт?

Автор - Pelena
Дата добавления - 27.01.2019 в 21:38
Glass4217 Дата: Воскресенье, 27.01.2019, 22:03 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, но ведь в этом макросе опять идет поворот именно по центру группы, а не по центру зеленого круга.

Если например увеличить размеры ромба, то центр группы изменится и при повороте - зеленый круг вновь начнет смещаться.
 
Ответить
СообщениеPelena, но ведь в этом макросе опять идет поворот именно по центру группы, а не по центру зеленого круга.

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

Автор - Glass4217
Дата добавления - 27.01.2019 в 22:03
Pelena Дата: Воскресенье, 27.01.2019, 22:09 | Сообщение № 9
Группа: Админы
Ранг: Местный житель
Сообщений: 13879
Репутация: 3044 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Делайте группу симметричной относительно круга. Заметили, что там есть второй ромб в противовес первому? прозрачный


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеДелайте группу симметричной относительно круга. Заметили, что там есть второй ромб в противовес первому? прозрачный

Автор - Pelena
Дата добавления - 27.01.2019 в 22:09
Glass4217 Дата: Воскресенье, 27.01.2019, 22:20 | Сообщение № 10
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, а вот этот ромб, который в противовес идет - его можно сделать невыделяемым ?

Потому что он сейчас - несмотря на то, что прозрачный - выделяется мышкой.
 
Ответить
СообщениеPelena, а вот этот ромб, который в противовес идет - его можно сделать невыделяемым ?

Потому что он сейчас - несмотря на то, что прозрачный - выделяется мышкой.

Автор - Glass4217
Дата добавления - 27.01.2019 в 22:20
bmv98rus Дата: Воскресенье, 27.01.2019, 22:51 | Сообщение № 11
Группа: Проверенные
Ранг: Старожил
Сообщений: 2030
Репутация: 321 ±
Замечаний: 20% ±

Excel 2013/2016
Проведите отрезок от вершины до окружности. его перенесите на противоположную сторону. Потом можно сделать его минимальной длинны и прозрачным. В группе он поможет вращать вогруг центра круга, а выделить его будет еще труднее.


Замечательный медведь, процентов на 20.
 
Ответить
СообщениеПроведите отрезок от вершины до окружности. его перенесите на противоположную сторону. Потом можно сделать его минимальной длинны и прозрачным. В группе он поможет вращать вогруг центра круга, а выделить его будет еще труднее.

Автор - bmv98rus
Дата добавления - 27.01.2019 в 22:51
Pelena Дата: Воскресенье, 27.01.2019, 23:08 | Сообщение № 12
Группа: Админы
Ранг: Местный житель
Сообщений: 13879
Репутация: 3044 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
можно сделать невыделяемым ?

думаю, что нет


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
Сообщение
можно сделать невыделяемым ?

думаю, что нет

Автор - Pelena
Дата добавления - 27.01.2019 в 23:08
Glass4217 Дата: Воскресенье, 27.01.2019, 23:10 | Сообщение № 13
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
bmv98rus, понимаете в чем дело...
Вот эта система противовесов - она не очень хорошая.

Эта система предполагает, что за фигурой будет достаточно пространства для разворота.
А если такого пространства нет - что тогда ?

Например если эта группа находится вплотную у левого края экрана, а целевая фигура - находится по правую сторону.
В этом случае - при повороте - группа будет искажена.
То есть изменится ее ширина и высота.
 
Ответить
Сообщениеbmv98rus, понимаете в чем дело...
Вот эта система противовесов - она не очень хорошая.

Эта система предполагает, что за фигурой будет достаточно пространства для разворота.
А если такого пространства нет - что тогда ?

Например если эта группа находится вплотную у левого края экрана, а целевая фигура - находится по правую сторону.
В этом случае - при повороте - группа будет искажена.
То есть изменится ее ширина и высота.

Автор - Glass4217
Дата добавления - 27.01.2019 в 23:10
Roman777 Дата: Понедельник, 28.01.2019, 09:49 | Сообщение № 14
Группа: Проверенные
Ранг: Ветеран
Сообщений: 957
Репутация: 123 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Glass4217, Необходимо почитать про матрицу поворота.
Вот пример поворота группы фигур "Группа 27" относительно центра фигуры "Овал 9"
[vba]
Код
Sub ShpRotate()
    'Википедия "Матрица поворота"
    Dim pnt(1 To 2) As Single, p0(1 To 2) As Single
    Dim angle As Single, Pi As Single
    Dim shp As Shape
    Dim shps() As Variant, elmt() As Variant, k As Long
    Dim dx As Single, dy As Single, c As Single, s As Single
    angle = 30
    Set gr = ActiveSheet.Shapes("Группа 27")
    ReDim shps(1 To gr.GroupItems.count)
    For Each shp In gr.GroupItems
        k = k + 1
        ReDim elmt(1 To 2, 1 To 1)
        Set elmt(1, 1) = shp
        pnt(1) = shp.Left + shp.Width / 2
        pnt(2) = shp.Top + shp.Height / 2
'        ActiveSheet.Shapes.AddShape 149, pnt(1), pnt(2), 5, 5
        elmt(2, 1) = pnt
        shps(k) = elmt
        If shp.Name = "Oval 9" Then
            p0(1) = pnt(1)
            p0(2) = pnt(2)
        End If
    Next shp
    Pi = 3.14159265358979
    c = Cos(angle * Pi / 180)
    s = Sin(angle * Pi / 180)
    For i = 1 To UBound(shps)
        dx = (shps(i)(2, 1)(1) - p0(1))
        dy = (shps(i)(2, 1)(2) - p0(2))
        shps(i)(1, 1).Left = dx * c - dy * s - dx + shps(i)(1, 1).Left
        shps(i)(1, 1).Top = dx * s + dy * c - dy + shps(i)(1, 1).Top
        shps(i)(1, 1).Rotation = shps(i)(1, 1).Rotation + angle
    Next i
End Sub
[/vba]
По этому макросу можете сделать отдельную функцию и кидать ей в качестве аргумента угол поворота.


Много чего не знаю!!!!
 
Ответить
СообщениеGlass4217, Необходимо почитать про матрицу поворота.
Вот пример поворота группы фигур "Группа 27" относительно центра фигуры "Овал 9"
[vba]
Код
Sub ShpRotate()
    'Википедия "Матрица поворота"
    Dim pnt(1 To 2) As Single, p0(1 To 2) As Single
    Dim angle As Single, Pi As Single
    Dim shp As Shape
    Dim shps() As Variant, elmt() As Variant, k As Long
    Dim dx As Single, dy As Single, c As Single, s As Single
    angle = 30
    Set gr = ActiveSheet.Shapes("Группа 27")
    ReDim shps(1 To gr.GroupItems.count)
    For Each shp In gr.GroupItems
        k = k + 1
        ReDim elmt(1 To 2, 1 To 1)
        Set elmt(1, 1) = shp
        pnt(1) = shp.Left + shp.Width / 2
        pnt(2) = shp.Top + shp.Height / 2
'        ActiveSheet.Shapes.AddShape 149, pnt(1), pnt(2), 5, 5
        elmt(2, 1) = pnt
        shps(k) = elmt
        If shp.Name = "Oval 9" Then
            p0(1) = pnt(1)
            p0(2) = pnt(2)
        End If
    Next shp
    Pi = 3.14159265358979
    c = Cos(angle * Pi / 180)
    s = Sin(angle * Pi / 180)
    For i = 1 To UBound(shps)
        dx = (shps(i)(2, 1)(1) - p0(1))
        dy = (shps(i)(2, 1)(2) - p0(2))
        shps(i)(1, 1).Left = dx * c - dy * s - dx + shps(i)(1, 1).Left
        shps(i)(1, 1).Top = dx * s + dy * c - dy + shps(i)(1, 1).Top
        shps(i)(1, 1).Rotation = shps(i)(1, 1).Rotation + angle
    Next i
End Sub
[/vba]
По этому макросу можете сделать отдельную функцию и кидать ей в качестве аргумента угол поворота.

Автор - Roman777
Дата добавления - 28.01.2019 в 09:49
Glass4217 Дата: Понедельник, 28.01.2019, 10:07 | Сообщение № 15
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Roman777, а как этот код - вот к этому макросу подключить ?
[vba]
Код

Private s1 As Shape, s2 As Shape, s3 As Shape, s4 As Object

Public x2 As Integer
Public y2 As Integer
Public Alfa As Integer

Public Sub Запуск1()

    With ActiveSheet
        X1 = .Shapes("Oval 3").Left + .Shapes("Oval 3").Width / 2
        Y1 = .Shapes("Oval 3").Top + .Shapes("Oval 3").Height / 2
        x2 = .Shapes("Up Arrow 2").Left + .Shapes("Up Arrow 2").Width / 2
        y2 = .Shapes("Up Arrow 2").Top + .Shapes("Up Arrow 2").Height / 2
        x = X1 - x2
        y = Y1 - y2
        .Shapes("Up Arrow 2").Rotation = Application.WorksheetFunction.Atan2(x, y) * 180 / 3.14 + 90
        Alfa = Application.WorksheetFunction.Atan2(x, y) * 180 / 3.14 + 90
    End With
    
End Sub
[/vba]
 
Ответить
СообщениеRoman777, а как этот код - вот к этому макросу подключить ?
[vba]
Код

Private s1 As Shape, s2 As Shape, s3 As Shape, s4 As Object

Public x2 As Integer
Public y2 As Integer
Public Alfa As Integer

Public Sub Запуск1()

    With ActiveSheet
        X1 = .Shapes("Oval 3").Left + .Shapes("Oval 3").Width / 2
        Y1 = .Shapes("Oval 3").Top + .Shapes("Oval 3").Height / 2
        x2 = .Shapes("Up Arrow 2").Left + .Shapes("Up Arrow 2").Width / 2
        y2 = .Shapes("Up Arrow 2").Top + .Shapes("Up Arrow 2").Height / 2
        x = X1 - x2
        y = Y1 - y2
        .Shapes("Up Arrow 2").Rotation = Application.WorksheetFunction.Atan2(x, y) * 180 / 3.14 + 90
        Alfa = Application.WorksheetFunction.Atan2(x, y) * 180 / 3.14 + 90
    End With
    
End Sub
[/vba]

Автор - Glass4217
Дата добавления - 28.01.2019 в 10:07
Roman777 Дата: Понедельник, 28.01.2019, 10:17 | Сообщение № 16
Группа: Проверенные
Ранг: Ветеран
Сообщений: 957
Репутация: 123 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Glass4217,

Попробуйте в таком виде. Я не проверял направления вращения, поэтому если будет крутить не в ту сторону, то либо править функцию, либо при её вызове [vba]
Код
ShpRotate(-Alfa)
[/vba]


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Понедельник, 28.01.2019, 10:17
 
Ответить
СообщениеGlass4217,

Попробуйте в таком виде. Я не проверял направления вращения, поэтому если будет крутить не в ту сторону, то либо править функцию, либо при её вызове [vba]
Код
ShpRotate(-Alfa)
[/vba]

Автор - Roman777
Дата добавления - 28.01.2019 в 10:17
Glass4217 Дата: Понедельник, 28.01.2019, 11:26 | Сообщение № 17
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Roman777, сейчас фигура вращается вроде в ту строну, в которую нужно, но с рассинхронизацией вращения со стрелкой.
И вращается - бесконечно.
То есть даже если целевая фигура неподвижна - ромб все равно продолжает вращаться при нажатии макроса.
К сообщению приложен файл: -2-.xls(72.0 Kb)
 
Ответить
СообщениеRoman777, сейчас фигура вращается вроде в ту строну, в которую нужно, но с рассинхронизацией вращения со стрелкой.
И вращается - бесконечно.
То есть даже если целевая фигура неподвижна - ромб все равно продолжает вращаться при нажатии макроса.

Автор - Glass4217
Дата добавления - 28.01.2019 в 11:26
Roman777 Дата: Понедельник, 28.01.2019, 13:13 | Сообщение № 18
Группа: Проверенные
Ранг: Ветеран
Сообщений: 957
Репутация: 123 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Glass4217, Чесно говоря, очень странное поведение. Я в VBA такими методами не пользовался и даже упрощение кода до:
[vba]
Код
Function ShpRotate2(angle As Single)
    Dim p0(1 To 2) As Single, p1(1 To 2) As Single
    Dim Pi As Single
    Dim shp As Shape
    Dim dx As Single, dy As Single, c As Single, s As Single
    Dim gr As Shape
    Set gr = ActiveSheet.Shapes("Группа 27")
    For Each shp In gr.GroupItems
        If shp.Name = "Oval 9" Then
            p0(1) = shp.Left + shp.Width / 2
            p0(2) = shp.Top + shp.Height / 2
        End If
    Next shp
    p1(1) = gr.Left + gr.Width / 2
    p1(2) = gr.Top + gr.Height / 2
    Pi = 3.14159265358979
    c = Cos(angle * Pi / 180)
    s = Sin(angle * Pi / 180)
    dx = (p1(1) - p0(1))
    dy = (p1(2) - p0(2))
    gr.Left = dx * c - dy * s - dx + gr.Left
    gr.Top = dx * s + dy * c - dy + gr.Top
    gr.IncrementRotation (angle)
End Function
[/vba]
Проблему с вращением только ромба не решило. Пока не могу понять в чём дело))) (при пошаговом исполнении кода всё замечательно что с этим вариантом, что с предыдущим).
Относительно постоянного вращение: она вращает ровно на тот угол, который отправляете в неё. если хотите ограничить, делайте условие, или ограничения.


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Понедельник, 28.01.2019, 13:14
 
Ответить
СообщениеGlass4217, Чесно говоря, очень странное поведение. Я в VBA такими методами не пользовался и даже упрощение кода до:
[vba]
Код
Function ShpRotate2(angle As Single)
    Dim p0(1 To 2) As Single, p1(1 To 2) As Single
    Dim Pi As Single
    Dim shp As Shape
    Dim dx As Single, dy As Single, c As Single, s As Single
    Dim gr As Shape
    Set gr = ActiveSheet.Shapes("Группа 27")
    For Each shp In gr.GroupItems
        If shp.Name = "Oval 9" Then
            p0(1) = shp.Left + shp.Width / 2
            p0(2) = shp.Top + shp.Height / 2
        End If
    Next shp
    p1(1) = gr.Left + gr.Width / 2
    p1(2) = gr.Top + gr.Height / 2
    Pi = 3.14159265358979
    c = Cos(angle * Pi / 180)
    s = Sin(angle * Pi / 180)
    dx = (p1(1) - p0(1))
    dy = (p1(2) - p0(2))
    gr.Left = dx * c - dy * s - dx + gr.Left
    gr.Top = dx * s + dy * c - dy + gr.Top
    gr.IncrementRotation (angle)
End Function
[/vba]
Проблему с вращением только ромба не решило. Пока не могу понять в чём дело))) (при пошаговом исполнении кода всё замечательно что с этим вариантом, что с предыдущим).
Относительно постоянного вращение: она вращает ровно на тот угол, который отправляете в неё. если хотите ограничить, делайте условие, или ограничения.

Автор - Roman777
Дата добавления - 28.01.2019 в 13:13
Roman777 Дата: Понедельник, 28.01.2019, 14:23 | Сообщение № 19
Группа: Проверенные
Ранг: Ветеран
Сообщений: 957
Репутация: 123 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Glass4217, Дошли руки... Сразу не увидел, что стрелку Вы уже повернули:
Так должно работать:


Много чего не знаю!!!!
 
Ответить
СообщениеGlass4217, Дошли руки... Сразу не увидел, что стрелку Вы уже повернули:
Так должно работать:

Автор - Roman777
Дата добавления - 28.01.2019 в 14:23
Glass4217 Дата: Понедельник, 28.01.2019, 15:47 | Сообщение № 20
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Roman777, теперь все просто идеально.
Огромное спасибо.
 
Ответить
СообщениеRoman777, теперь все просто идеально.
Огромное спасибо.

Автор - Glass4217
Дата добавления - 28.01.2019 в 15:47
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поворот объекта, в зависимости от поворота другого объекта. (Макросы/Sub)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

Яндекс цитирования
© 2010-2019 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!