' Associated Nasik Magic Cubes (m = 2x + 1, m >= 9, gcd(m, 3 x 5 x 7) = m)
' Tested with Office 2007 under Windows 7
Dim R35(3, 5)
Sub AssNasik23a()
y = MsgBox("Locked", vbCritical, "Routine AssNasik23a")
End
' Magic Rectangle R35:
'R35(1, 1) = 14: R35(1, 2) = 10: R35(1, 3) = 4: R35(1, 4) = 5: R35(1, 5) = 7:
'R35(2, 1) = 1: R35(2, 2) = 3: R35(2, 3) = 8: R35(2, 4) = 13: R35(2, 5) = 15:
'R35(3, 1) = 9: R35(3, 2) = 11: R35(3, 3) = 12: R35(3, 4) = 6: R35(3, 5) = 2:
' Read Rectangle R35 from Spreadsheet (line format)
m = 15
For j10 = 1 To 16 'line number 1 ... 16 in Worksheet 'R35'
Sheets.Add: sht1 = ActiveSheet.Name: Sheets(sht1).Name = "Cubes" + CStr(j10)
k1 = 1: k2 = 0
For j20 = 1 To 15
k2 = k2 + 1: If k2 = 6 Then k2 = 1: k1 = k1 + 1
R35(k1, k2) = Sheets("R35").Cells(j10, j20).Value
Next j20
k1 = 0: k2 = 0
i1 = 0: j1 = 0: j2 = 0
For k = 0 To m - 1
For i = 0 To m - 1
i1 = i1 + 1
For j = 0 To m - 1
j1 = j1 + 1: j2 = j2 + 1
b = i + 2 * j + 4 * k + 3
c = i - 2 * j + 4 * k + 1
While c < 0
c = c + m
Wend
d = i + 2 * j - 4 * k - 1
While d < 0
d = d + m
Wend
b1 = b Mod m
c1 = c Mod m
d1 = d Mod m
a = S15(b1) * m ^ 2 + S15(c1) * m + S15(d1) + 1
' Print Cube
If j1 = m + 1 Then j1 = 1
If j2 = m ^ 2 + 1 Then j2 = 1: i1 = i1 + 1
Cells(i1 + 1, j1 + 1).Value = a
' print Components
' Cells(i1 + 1, j1 + 1 + 9).Value = b1
' Cells(i1 + 1, j1 + 1 + 18).Value = c1
' Cells(i1 + 1, j1 + 1 + 27).Value = d1
Next j
Next i
Next k
Next j10
End Sub
Function S15(x)
x1 = x Mod 3
y1 = x Mod 5
S15 = R35(x1 + 1, y1 + 1) - 1
End Function
