About the Author

' Associated Pantriagonal Magic Cubes (m >= 6)

' Tested with Office 2007 under Windows 7

Sub AssPntr6()

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

Sheets("Klad1").Select

m = 6

For k = 0 To m - 1

If Int(k / 2) = k / 2 Then    'k is even
    k1 = k / 2
Else                          'k is odd
    k1 = (m - 1 - k) / 2
End If

For i = 0 To m - 1
i11 = i11 + 1

If Int(i / 2) = i / 2 Then    'i is even
    i1 = i / 2
Else                          'i is odd
    i1 = (m - 1 - i) / 2
End If

For j = 0 To m - 1
j11 = j11 + 1: j12 = j12 + 1

If Int(j / 2) = j / 2 Then    'j is even
    j1 = j / 2
Else                          'j is odd
    j1 = (m - 1 - j) / 2
End If
        
'   t1 = (i1 + j1 - 2 * k1) Mod (m / 2)
'   t2 = (-i1 - j1 + 2 * k1) Mod (m / 2)

'   replaced modulo operator by: 
'   n MOD d = n - d * INT(n / d)        

    t1 = (i1 + j1 - 2 * k1) - (m / 2) * Int((i1 + j1 - 2 * k1) / (m / 2))
    t2 = (-i1 - j1 + 2 * k1) - (m / 2) * Int((-i1 - j1 + 2 * k1) / (m / 2))
        
    If t1 < t2 Then t = t1 Else t = t2
        
    v0 = 4 * (k Mod 2) + 2 * (j Mod 2) + ((i + j + k) Mod 2)

    If Int(v0 / 2) = v0 / 2 Then  'v0 is even
       v1 = 7 - v0 / 2
    Else                          'v0 is odd
       v1 = 3 - (v0 - 1) / 2
    End If

    If Int((i + j + k) / 2) = (i + j + k) / 2 Then                   '(i+j+k) is even
       c1 = k1 * (m / 2) ^ 2 + i1 * (m / 2) + j1
    Else                                                             '(i+j+k) is odd
       c1 = (m / 2) ^ 3 - 1 - (k1 * (m / 2) ^ 2 + i1 * (m / 2) + j1)
    End If

    If t = (m - 2) / 4 Then
       b1 = v1
    Else
    
        If Int((t + (m - 2) / 4) / 2) = (t + (m - 2) / 4) / 2 Then  '(t + (m-2)/4) is even
           b1 = 7 - v0
        Else                                                        '(t + (m-2)/4) is odd
           b1 = v0
        End If
    
    End If
    
    a1 = b1 * (m / 2) ^ 3 + c1 + 1
    
'   Print Cube

    If j11 = m + 1 Then j11 = 1
    If j12 = m ^ 2 + 1 Then j12 = 1: i11 = i11 + 1
    Cells(i11 + 1, j11 + 1).Value = a1

'   print Components

'   Cells(i11 + 1, j11 + 1 + 22).Value = b1
'   Cells(i11 + 1, j11 + 1 + 29).Value = c1

Next j
Next i
Next k

End Sub

About the Author