このファイル: /home/web6047/www/cgi-bin/prj/20180511-svc_edit/_preview/LocalAxis.txt
1
Option Explicit
2
Private stack(100) As Object
3
Private transX As Integer
4
Private transY As Integer
5
Private transT As Double
6
Private addX As Integer
7
Private addY As Integer
8
Private addT As Double
9
Private index As Integer
10
Public genten2 As shape
11
Public currentName As String
12
13
14
Private Sub Class_Initialize()
15
index = -1
16
transX = 0
17
transY = 0
18
transT = 0
19
Set genten2 = ActiveSheet.Shapes("ローカル原点")
20
End Sub
21
Public Sub translate(x As Integer, y As Integer)
22
Dim mn() As Integer
23
mn = kaiten(0, 0, x, y, transT)
24
transX = transX + mn(0)
25
transY = transY + mn(1)
26
addX = x
27
addY = y
28
End Sub
29
Public Sub rotate(t As Double)
30
transT = transT + t
31
addT = t
32
End Sub
33
Public Sub rotateByKakudo(kakudo As Integer)
34
Call rotate(k2r(kakudo))
35
End Sub
36
Public Function gx(lx As Integer) As Integer
37
gx = transX + lx
38
End Function
39
Public Function gy(ly As Integer) As Integer
40
gy = transY + ly
41
End Function
42
Public Function gt(lt As Double) As Double
43
gt = transT + lt
44
End Function
45
Public Function gk(lk As Integer) As Integer
46
gk = r2k(transT) + lk
47
End Function
48
Public Sub save()
49
Dim obj As Object
50
Set obj = CreateObject("Scripting.Dictionary")
51
obj.Add "transX", transX
52
obj.Add "transY", transY
53
obj.Add "transT", transT
54
index = index + 1
55
Set stack(index) = obj
56
End Sub
57
Public Sub restore()
58
Dim obj As Object
59
Set obj = stack(index)
60
index = index - 1
61
transX = obj("transX")
62
transY = obj("transY")
63
transT = obj("transT")
64
End Sub
65
Public Sub shapeDraw(thisshape As shape, dx As Integer, dy As Integer)
66
Dim x As Integer: x = thisshape.Width / 2
67
Dim y As Integer: y = thisshape.Height / 2
68
Dim mn() As Integer
69
mn = kaiten(0, 0, dx + x, dy + y, transT)
70
thisshape.Left = gx(mn(0) - x)
71
thisshape.Top = gy(mn(1) - y)
72
thisshape.Rotation = r2k(transT)
73
If thisshape.name = currentName Then
74
Debug.Print thisshape.name
75
genten2.Left = transX - genten2.Width / 2
76
genten2.Top = transY - genten2.Height / 2
77
Debug.Print genten2.Left
78
Debug.Print genten2.Top
79
End If
80
End Sub
81
Function k2r(kakudo As Integer)
82
k2r = kakudo * (3.141592 / 180)
83
End Function
84
Function r2k(rad As Double)
85
r2k = rad * (180 / 3.14159)
86
End Function
87
Function kaiten(ByVal cx As Integer, ByVal cy As Integer, ByVal fromX As Integer, ByVal fromY As Integer, ByVal theta2 As Double) As Integer()
88
Dim res(1) As Integer, theta1 As Double, hankei As Integer
89
fromX = fromX - cx
90
fromY = fromY - cy
91
'check.
92
If fromX = 0 And fromY = 0 Then
93
res(0) = 0
94
res(1) = 0
95
kaiten = res
96
Exit Function
97
End If
98
theta1 = WorksheetFunction.Atan2(fromX, fromY)
99
Dim fromXL As Long: fromXL = fromX
100
Dim fromYL As Long: fromYL = fromY
101
hankei = Sqr(fromXL * fromXL + fromYL * fromYL)
102
res(0) = Cos(theta1 + theta2) * hankei + cx
103
res(1) = Sin(theta1 + theta2) * hankei + cy
104
kaiten = res
105
End Function