AW: Linie drehen lassen
21.07.2006 12:21:37
Matthias
Hallo Chris,
hier noch dioe Mathematik:
Sub test()
Const Pi = 3.14159265358979
Dim parr, i, j, x As Double, y As Double, cx As Double, cy As Double, r As Double
Dim kn
Dim xarr(0 To 59) As Double
Dim yarr(0 To 59) As Double
Dim w As Integer
Dim ws As Double
parr = ActiveSheet.Shapes(1).Nodes(2).Points
'Zentrum ermitteln:
cx = parr(1, 1)
cy = parr(1, 2)
'Debug.Print cx, cy
'Punkt ermitteln:
parr = ActiveSheet.Shapes(1).Nodes(1).Points
x = parr(1, 1)
y = parr(1, 2)
'Abstand ermitteln:
r = Sqr((x - cx) * (x - cx) + (y - cy) * (y - cy))
Debug.Print r
'Punktarray mit 60 Koordinaten erstellen:
For w = 0 To 59
ws = w * (2 * Pi / 60) + Pi
xarr(w) = cx - Sin(ws) * r
yarr(w) = cy + Cos(ws) * r
Next w
'Kreisen lassen:
For i = 0 To 59
ActiveSheet.Shapes(1).Nodes.SetPosition 1, xarr(i), yarr(i)
Application.Wait Now + TimeValue("00:00:01")
Next i
End Sub
Gruß Matthias