About the Author

' Non-associated Pantriagonal Magic Cubes, 2D-compact and Complete (m = 4x)

' Tested with Office 2007 under Windows 7

Sub CnstrPntr4x()

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

Sheets("Klad1").Select

m = 8

For i = 0 To m - 1
For j = 0 To m - 1
j1 = j1 + 1
For k = 0 To m - 1
k1 = k1 + 1: k2 = k2 + 1


    b = (i + (m / 2) * j + (m / 2) * k) Mod m
    c = ((m / 2) * i + j + (m / 2) * k) Mod m
    d = ((m / 2) * i + (m / 2) * j + k) Mod m
    
    a = Tm(b, m) * m ^ 2 + Tm(c, m) * m + Tm(d, m) + 1

'   Print Cube

    If k1 = m + 1 Then k1 = 1
    If k2 = m ^ 2 + 1 Then k2 = 1: j1 = j1 + 1
    Cells(j1 + 1, k1 + 1).Value = a

'   Print Components
    
'   Cells(j1 + 1, k1 + 1 + (m + 1)).Value = b      ' Tm(b, m)
'   Cells(j1 + 1, k1 + 1 + 2 * (m + 1)).Value = c  'Tm(c, m)
'   Cells(j1 + 1, k1 + 1 + 3 * (m + 1)).Value = d  'Tm(d, m)

Next k
Next j
Next i

End Sub

Function Tm(x, m)

    If x < m / 2 Then
        Tm = x
    Else
        Tm = 3 * m / 2 - 1 - x
    End If

End Function

About the Author