' Generates Perfect Concentric Magic Cubes of order 6 (Prime Numbers)
' Part III: Putting it all together (f)
' Tested with Office 365 under Windows 10
Sub PrimeCubes78f()
Dim a(72), C4(64), C6(216)
y = MsgBox("Locked", vbCritical, "Routine PrimeCubes78f")
End
n2 = 0: n9 = 0: k1 = 1: k2 = 1
ShtNm1 = "Cubes4" ' Center Cube
ShtNm2 = "TopSqrs6" ' Top Square
ShtNm3 = "BackSqrs6" ' Back Square
ShtNm4 = "LeftSqrs6" ' Left Square
Sheets("Klad1").Select
t1 = Timer
For j100 = 2 To 2 'Left Plane
MC6 = Sheets(ShtNm4).Cells(j100, 37).Value
Rcrd1a = Sheets(ShtNm4).Cells(j100, 38).Value 'Cube
Rcrd1b = Sheets(ShtNm4).Cells(j100, 39).Value 'Top / Bottom Plane
Rcrd1c = Sheets(ShtNm4).Cells(j100, 40).Value 'Back / Front Plane
Pr6 = MC6 / 3: s6 = MC6
' Read Top / Bottom Square
For i1 = 1 To 72
a(i1) = Sheets(ShtNm2).Cells(Rcrd1b, i1).Value
Next i1
GoSub 1760
' Read Back / Front Square
For i1 = 1 To 48
a(i1) = Sheets(ShtNm3).Cells(Rcrd1c, i1).Value
Next i1
GoSub 1770
' Read Left Square / Determine Right Square
For i1 = 1 To 36
a(i1) = Sheets(ShtNm4).Cells(j100, i1).Value
Next i1
GoSub 1780
' Read Center Cube
For i1 = 1 To 64
C4(i1) = Sheets(ShtNm1).Cells(Rcrd1a, i1).Value
Next i1
GoSub 1790
' Back Check Identical Numbers
GoSub 800
If fl1 = 1 Then
' Print Cube
n9 = n9 + 1: GoSub 1750
End If
Next j100
End
' Exclude solutions with identical numbers
800 fl1 = 1
For j1 = 1 To 216
c20 = C6(j1): If c20 = 0 Then GoTo 810
For j2 = (1 + j1) To 216
If c20 = C6(j2) Then fl1 = 0: Return
Next j2
810 Next j1
Return
' Print results (6 plane format)
1750 n2 = n2 + 1
If n2 = 4 Then
n2 = 1: k1 = k1 + 42: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 7
End If
Cells(k1, k2 + 1).Select
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = "MC = " + CStr(s6)
For i0 = 1 To 6
i3 = (6 - i0) * 36
For i1 = 1 To 6
For i2 = 1 To 6
i3 = i3 + 1
Cells(k1 + i1 + (i0 - 1) * 7, k2 + i2).Value = C6(i3)
Next i2
Next i1
Next i0
Return
1760
' Top Square
For i1 = 1 To 36
C6(i1) = a(i1)
Next i1
' Bottom Square
For i1 = 37 To 72
C6(i1 - 36 + 180) = a(i1)
Next i1
Return
1770
' Back Square
C6(37) = a(1): C6(38) = a(2): C6(39) = a(3): C6(40) = a(4): C6(41) = a(5): C6(42) = a(6):
C6(73) = a(7): C6(74) = a(8): C6(75) = a(9): C6(76) = a(10): C6(77) = a(11): C6(78) = a(12):
C6(109) = a(13): C6(110) = a(14): C6(111) = a(15): C6(112) = a(16): C6(113) = a(17): C6(114) = a(18):
C6(145) = a(19): C6(146) = a(20): C6(147) = a(21): C6(148) = a(22): C6(149) = a(23): C6(150) = a(24):
' Front Square
C6(67) = Pr6 - C6(42): C6(68) = Pr6 - C6(38): C6(69) = Pr6 - C6(39): C6(70) = Pr6 - C6(40):
C6(71) = Pr6 - C6(41): C6(72) = Pr6 - C6(37):
C6(103) = Pr6 - C6(78): C6(104) = Pr6 - C6(74): C6(105) = Pr6 - C6(75): C6(106) = Pr6 - C6(76):
C6(107) = Pr6 - C6(77): C6(108) = Pr6 - C6(73):
C6(139) = Pr6 - C6(114): C6(140) = Pr6 - C6(110): C6(141) = Pr6 - C6(111): C6(142) = Pr6 - C6(112):
C6(143) = Pr6 - C6(113): C6(144) = Pr6 - C6(109):
C6(175) = Pr6 - C6(150): C6(176) = Pr6 - C6(146): C6(177) = Pr6 - C6(147): C6(178) = Pr6 - C6(148):
C6(179) = Pr6 - C6(149): C6(180) = Pr6 - C6(145):
Return
1780
' Left Square
C6(43) = a(8): C6(49) = a(9): C6(55) = a(10): C6(61) = a(11):
C6(79) = a(14): C6(85) = a(15): C6(91) = a(16): C6(97) = a(17):
C6(115) = a(20): C6(121) = a(21): C6(127) = a(22): C6(133) = a(23):
C6(151) = a(26): C6(157) = a(27): C6(163) = a(28): C6(169) = a(29):
' Right Square
C6(48) = Pr6 - C6(43): C6(54) = Pr6 - C6(49): C6(60) = Pr6 - C6(55): C6(66) = Pr6 - C6(61):
C6(84) = Pr6 - C6(79): C6(90) = Pr6 - C6(85): C6(96) = Pr6 - C6(91): C6(102) = Pr6 - C6(97):
C6(120) = Pr6 - C6(115): C6(126) = Pr6 - C6(121): C6(132) = Pr6 - C6(127): C6(138) = Pr6 - C6(133):
C6(156) = Pr6 - C6(151): C6(162) = Pr6 - C6(157): C6(168) = Pr6 - C6(163): C6(174) = Pr6 - C6(169):
Return
1790
' Center Cube
C6(44) = C4(1): C6(45) = C4(2): C6(46) = C4(3): C6(47) = C4(4):
C6(50) = C4(5): C6(51) = C4(6): C6(52) = C4(7): C6(53) = C4(8):
C6(56) = C4(9): C6(57) = C4(10): C6(58) = C4(11): C6(59) = C4(12):
C6(62) = C4(13): C6(63) = C4(14): C6(64) = C4(15): C6(65) = C4(16):
C6(80) = C4(17): C6(81) = C4(18): C6(82) = C4(19): C6(83) = C4(20):
C6(86) = C4(21): C6(87) = C4(22): C6(88) = C4(23): C6(89) = C4(24):
C6(92) = C4(25): C6(93) = C4(26): C6(94) = C4(27): C6(95) = C4(28):
C6(98) = C4(29): C6(99) = C4(30): C6(100) = C4(31): C6(101) = C4(32):
C6(116) = C4(33): C6(117) = C4(34): C6(118) = C4(35): C6(119) = C4(36):
C6(122) = C4(37): C6(123) = C4(38): C6(124) = C4(39): C6(125) = C4(40):
C6(128) = C4(41): C6(129) = C4(42): C6(130) = C4(43): C6(131) = C4(44):
C6(134) = C4(45): C6(135) = C4(46): C6(136) = C4(47): C6(137) = C4(48):
C6(152) = C4(49): C6(153) = C4(50): C6(154) = C4(51): C6(155) = C4(52):
C6(158) = C4(53): C6(159) = C4(54): C6(160) = C4(55): C6(161) = C4(56):
C6(164) = C4(57): C6(165) = C4(58): C6(166) = C4(59): C6(167) = C4(60):
C6(170) = C4(61): C6(171) = C4(62): C6(172) = C4(63): C6(173) = C4(64):
Return
End Sub
