Здравствуйте, друзья. Помогите разобраться с тригонометрической задачей.
Есть макрос, поворачивающий фигуру по направлению к некоему объекту. Фигура представляет собой круг, стрелку и ромб. Круг не поворачивается вообще. Но это и ни к чему, поскольку он и так круглый со всех сторон. Стрелка поворачивается, по оси вращения проходящей через ее середину и центр круга. А вот ромб, который тоже входит в группу - находится не посередине, а на окончании стрелки.
Как этот ромб повернуть, вместе со стрелкой, чтобы он по прежнему оставался на конце стрелки ?
Здравствуйте, друзья. Помогите разобраться с тригонометрической задачей.
Есть макрос, поворачивающий фигуру по направлению к некоему объекту. Фигура представляет собой круг, стрелку и ромб. Круг не поворачивается вообще. Но это и ни к чему, поскольку он и так круглый со всех сторон. Стрелка поворачивается, по оси вращения проходящей через ее середину и центр круга. А вот ромб, который тоже входит в группу - находится не посередине, а на окончании стрелки.
Как этот ромб повернуть, вместе со стрелкой, чтобы он по прежнему оставался на конце стрелки ?Glass4217
1. Ищите и применяйте для смещения ромба формулу поворота точки вокруг другой, в данном случае центр стрелки. Рассчитать его надеюсь сможете. 2. Ну и поворот ромба вокруг своего центра на нужный Вам угол.
При желании можно всю группу сразу вращать, но тогда надо рассчитать компенсирующее смещение для центра круга или стрелки и после поворода передвинуть всю группу.
1. Ищите и применяйте для смещения ромба формулу поворота точки вокруг другой, в данном случае центр стрелки. Рассчитать его надеюсь сможете. 2. Ну и поворот ромба вокруг своего центра на нужный Вам угол.
При желании можно всю группу сразу вращать, но тогда надо рассчитать компенсирующее смещение для центра круга или стрелки и после поворода передвинуть всю группу.bmv98rus
Замечательный Временно просто медведь , процентов на 20.
Сообщение отредактировал bmv98rus - Воскресенье, 27.01.2019, 09:42
bmv98rus, вот ровным счетом об этом я и спрашивал. Как эту фигуру повернуть, вместе со стрелкой, чтобы она по прежнему оставалась на конце стрелки ?
bmv98rus, вот ровным счетом об этом я и спрашивал. Как эту фигуру повернуть, вместе со стрелкой, чтобы она по прежнему оставалась на конце стрелки ?Glass4217
Проведите отрезок от вершины до окружности. его перенесите на противоположную сторону. Потом можно сделать его минимальной длинны и прозрачным. В группе он поможет вращать вогруг центра круга, а выделить его будет еще труднее.
Проведите отрезок от вершины до окружности. его перенесите на противоположную сторону. Потом можно сделать его минимальной длинны и прозрачным. В группе он поможет вращать вогруг центра круга, а выделить его будет еще труднее.bmv98rus
Замечательный Временно просто медведь , процентов на 20.
bmv98rus, понимаете в чем дело... Вот эта система противовесов - она не очень хорошая.
Эта система предполагает, что за фигурой будет достаточно пространства для разворота. А если такого пространства нет - что тогда ?
Например если эта группа находится вплотную у левого края экрана, а целевая фигура - находится по правую сторону. В этом случае - при повороте - группа будет искажена. То есть изменится ее ширина и высота.
bmv98rus, понимаете в чем дело... Вот эта система противовесов - она не очень хорошая.
Эта система предполагает, что за фигурой будет достаточно пространства для разворота. А если такого пространства нет - что тогда ?
Например если эта группа находится вплотную у левого края экрана, а целевая фигура - находится по правую сторону. В этом случае - при повороте - группа будет искажена. То есть изменится ее ширина и высота.Glass4217
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
End Sub Function ShpRotate(angle as single) Dim pnt(1 To 2) As Single, p0(1 To 2) As Single Dim 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 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]
Попробуйте в таком виде. Я не проверял направления вращения, поэтому если будет крутить не в ту сторону, то либо править функцию, либо при её вызове [vba]
Код
ShpRotate(-Alfa)
[/vba]
Glass4217,
[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 single
End Sub Function ShpRotate(angle as single) Dim pnt(1 To 2) As Single, p0(1 To 2) As Single Dim 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 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]
Попробуйте в таком виде. Я не проверял направления вращения, поэтому если будет крутить не в ту сторону, то либо править функцию, либо при её вызове [vba]
Roman777, сейчас фигура вращается вроде в ту строну, в которую нужно, но с рассинхронизацией вращения со стрелкой. И вращается - бесконечно. То есть даже если целевая фигура неподвижна - ромб все равно продолжает вращаться при нажатии макроса.
Roman777, сейчас фигура вращается вроде в ту строну, в которую нужно, но с рассинхронизацией вращения со стрелкой. И вращается - бесконечно. То есть даже если целевая фигура неподвижна - ромб все равно продолжает вращаться при нажатии макроса.Glass4217
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] Проблему с вращением только ромба не решило. Пока не могу понять в чём дело))) (при пошаговом исполнении кода всё замечательно что с этим вариантом, что с предыдущим). Относительно постоянного вращение: она вращает ровно на тот угол, который отправляете в неё. если хотите ограничить, делайте условие, или ограничения.
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
Много чего не знаю!!!!
Сообщение отредактировал Roman777 - Понедельник, 28.01.2019, 13:14
End Sub Function ShpRotate(angle As Single) Dim pnt(1 To 2) As Single, p0(1 To 2) As Single Dim 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 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 Function
[/vba]
Glass4217, Дошли руки... Сразу не увидел, что стрелку Вы уже повернули: Так должно работать:
[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 Single
End Sub Function ShpRotate(angle As Single) Dim pnt(1 To 2) As Single, p0(1 To 2) As Single Dim 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 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 Function
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
