About the Author

' 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 R357(3, 5, 7)

Sub AssNasik23d()

y = MsgBox("Locked", vbCritical, "Routine AssNasik23d")
End

' Read Rectangle R357 from Spreadsheet (line format)

m = 105

For j10 = 1 To 8       'line number 1 ... 8 in Worksheet 'R357'

Sheets.Add: sht1 = ActiveSheet.Name: Sheets(sht1).Name = "Cubes" + CStr(j10)

k1 = 1: k2 = 1: k3 = 0
For j20 = 1 To 105
    k3 = k3 + 1
    If k3 = 8 Then k3 = 1: k2 = k2 + 1
    If k2 = 6 Then k2 = 1: k1 = k1 + 1
    R357(k1, k2, k3) = Sheets("R357").Cells(j10, j20).Value
Next j20
k1 = 0: k2 = 0: k3 = 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 = S105(b1) * m ^ 2 + S105(c1) * m + S105(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 S105(x)
    
    x1 = x Mod 3
    y1 = x Mod 5
    z1 = x Mod 7
    S105 = R357(x1 + 1, y1 + 1, z1 + 1) - 1

End Function

About the Author