Симулятор кубика Рубика - вращающийся в одну сторону куба


В свободное время я работаю над имитируя кубик Рубика в Excel с помощью VBA: enter image description here

До сих пор у меня есть код, чтобы повернуть верхнюю и переднюю часть куба. В настоящее время я хранения значений левой, задней и нижней кубов на скрытый лист, называемый "заполнитель". Я ссылаюсь на передней, верхней и правой стороне кубиков на листе с именем "main". Я числа каждого кубика на стороне 1-9. Когда я вращать грани куба, я поверните его по часовой стрелке и переместите .Interior.Color к соответствующему куб, и из-за этого мне приходится иногда хранить одно из значений в placeholdercube, который находится всего в клетке A1 на листе "заполнитель".

Для того, для куба, чтобы его посмотреть, мне пришлось создать правой стороны треугольников и осторожно поместите их в каждом соответствующем углу. Всякий раз, когда я повернуть в стороны, каждый треугольник проверяет цвет он отвечает, то, соответственно, меняется.

Сейчас его немного неуклюжим - так что любые советы будут оценены!

Вот код для вращения передней части куба:

Sub RotateFront()
Application.ScreenUpdating = False
'Front rotation affects front, top, right, bottom and left
Dim frontcube1 As Range
Dim frontcube2 As Range
Dim frontcube3 As Range
Dim frontcube4 As Range
Dim frontcube5 As Range
Dim frontcube6 As Range
Dim frontcube7 As Range
Dim frontcube8 As Range
Dim frontcube9 As Range
Dim topcube7 As Range
Dim topcube8 As Range
Dim topcube9 As Range
Dim rightcube1 As Range
Dim rightcube4 As Range
Dim rightcube7 As Range
Dim bottomcube1 As Range
Dim bottomcube2 As Range
Dim bottomcube3 As Range
Dim leftcube3 As Range
Dim leftcube6 As Range
Dim leftcube9 As Range


Dim placeholdercube As Range
Dim numofturns As Range
Set placeholdercube = Worksheets("Placeholder").Range("A1")
Set numofturns = Worksheets("Main").Range("M16")

'cube layout:

'''''''''''''''''''''''''
'       '       '       '
' cube1 ' cube2 ' cube 3'
'       '       '       '
'''''''''''''''''''''''''
'       '       '       '
' cube4 ' cube5 ' cube6 '
'       '       '       '
'''''''''''''''''''''''''
'       '       '       '
' cube7 ' cube8 ' cube9 '
'       '       '       '
'''''''''''''''''''''''''

Set frontcube1 = Worksheets("Main").Range("B7") 'front3
Set frontcube2 = Worksheets("Main").Range("D7") 'front6
Set frontcube3 = Worksheets("Main").Range("F7") 'front9
Set frontcube4 = Worksheets("Main").Range("B10") 'front2
Set frontcube5 = Worksheets("Main").Range("D10") 'front5
Set frontcube6 = Worksheets("Main").Range("F10") 'front8
Set frontcube7 = Worksheets("Main").Range("B13") 'front1
Set frontcube8 = Worksheets("Main").Range("D13") 'front4
Set frontcube9 = Worksheets("Main").Range("F13") 'front7
Set topcube7 = Worksheets("Main").Range("C6") 'right1
Set topcube8 = Worksheets("Main").Range("E6") 'right4
Set topcube9 = Worksheets("Main").Range("G6") 'right7
Set rightcube1 = Worksheets("Main").Range("H7") 'bottom1
Set rightcube4 = Worksheets("Main").Range("H10") 'bottom2
Set rightcube7 = Worksheets("Main").Range("H13") 'bottom3
Set bottomcube1 = Worksheets("Placeholder").Range("C2") 'left3
Set bottomcube2 = Worksheets("Placeholder").Range("D2") 'left6
Set bottomcube3 = Worksheets("Placeholder").Range("E2") 'left9
Set leftcube3 = Worksheets("Placeholder").Range("E6") 'top7
Set leftcube6 = Worksheets("Placeholder").Range("E7") 'top8
Set leftcube9 = Worksheets("Placeholder").Range("E8") 'top9

'Rotate the front
placeholdercube.Interior.Color = frontcube9.Interior.Color
frontcube9.Interior.Color = frontcube3.Interior.Color
frontcube3.Interior.Color = frontcube1.Interior.Color
frontcube1.Interior.Color = frontcube7.Interior.Color
frontcube7.Interior.Color = placeholdercube.Interior.Color
placeholdercube.Interior.Color = frontcube8.Interior.Color
frontcube8.Interior.Color = frontcube6.Interior.Color
frontcube6.Interior.Color = frontcube2.Interior.Color
frontcube2.Interior.Color = frontcube4.Interior.Color
frontcube4.Interior.Color = placeholdercube.Interior.Color
'frontcube5.Interior.Color = frontcube5.Interior.Color - No change

'Rotate the other pieces
placeholdercube.Interior.Color = rightcube1.Interior.Color
rightcube1.Interior.Color = topcube7.Interior.Color
topcube7.Interior.Color = leftcube3.Interior.Color
leftcube3.Interior.Color = bottomcube1.Interior.Color
bottomcube1.Interior.Color = placeholdercube.Interior.Color
placeholdercube.Interior.Color = rightcube4.Interior.Color
rightcube4.Interior.Color = topcube8.Interior.Color
topcube8.Interior.Color = leftcube6.Interior.Color
leftcube6.Interior.Color = bottomcube2.Interior.Color
bottomcube2.Interior.Color = placeholdercube.Interior.Color
placeholdercube.Interior.Color = rightcube7.Interior.Color
rightcube7.Interior.Color = topcube9.Interior.Color
topcube9.Interior.Color = leftcube9.Interior.Color
leftcube9.Interior.Color = bottomcube3.Interior.Color
bottomcube3.Interior.Color = placeholdercube.Interior.Color

Dim piecearray As Variant, trianglearray1 As Variant, trianglearray2 As Variant, i As Long

piecearray = Array(topcube7, topcube8, topcube9, rightcube1, rightcube4, rightcube7)
trianglearray1 = Array(18, 24, 25, 3, 12, 15)
trianglearray2 = Array(30, 46, 36, 37, 42, 43)

For i = 0 To UBound(piecearray)

    'Change triangle pieces color
    If piecearray(i).Interior.Color = 255 Then 'red
    ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray1(i))).Select
        With Selection.ShapeRange.Fill
            .ForeColor.RGB = RGB(255, 0, 0)
        End With
    ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray2(i))).Select
        With Selection.ShapeRange.Fill
            .ForeColor.RGB = RGB(255, 0, 0)
        End With

    ElseIf piecearray(i).Interior.Color = 5287936 Then 'green
    ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray1(i))).Select
        With Selection.ShapeRange.Fill
            .ForeColor.RGB = RGB(0, 176, 80)
        End With
    ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray2(i))).Select
        With Selection.ShapeRange.Fill
            .ForeColor.RGB = RGB(0, 176, 80)
        End With

    ElseIf piecearray(i).Interior.Color = 12611584 Then 'blue
    ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray1(i))).Select
        With Selection.ShapeRange.Fill
            .ForeColor.RGB = RGB(0, 112, 192)
        End With
    ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray2(i))).Select
        With Selection.ShapeRange.Fill
            .ForeColor.RGB = RGB(0, 112, 192)
        End With

    ElseIf piecearray(i).Interior.Color = 65535 Then 'yellow
    ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray1(i))).Select
        With Selection.ShapeRange.Fill
            .ForeColor.RGB = RGB(255, 255, 0)
        End With
    ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray2(i))).Select
        With Selection.ShapeRange.Fill
            .ForeColor.RGB = RGB(255, 255, 0)
        End With

    ElseIf piecearray(i).Interior.Color = 49407 Then 'orange
    ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray1(i))).Select
        With Selection.ShapeRange.Fill
            .ForeColor.RGB = RGB(255, 192, 0)
        End With
    ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray2(i))).Select
        With Selection.ShapeRange.Fill
            .ForeColor.RGB = RGB(255, 192, 0)
        End With

    ElseIf piecearray(i).Interior.TintAndShade = 0 Then 'white
    ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray1(i))).Select
        With Selection.ShapeRange.Fill
            .ForeColor.ObjectThemeColor = msoThemeColorBackground1
            .ForeColor.TintAndShade = 0
        End With
    ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray2(i))).Select
        With Selection.ShapeRange.Fill
            .ForeColor.ObjectThemeColor = msoThemeColorBackground1
            .ForeColor.TintAndShade = 0
        End With
    End If

Next i

Range("A1").Select
'Increase number of turns by 1
numofturns.Value = numofturns.Value + 1
Application.ScreenUpdating = True
End Sub


198
2
задан 9 февраля 2018 в 11:02 Источник Поделиться
Комментарии
1 ответ

Отличная концепция и презентация очень неуклюжим. Давайте посмотрим, что мы можем сделать, чтобы сделать его легче визуализировать и манипулировать.

Работа с формами

Есть несколько вещей, которые можно сделать, чтобы улучшить , если заявление.

ElseIf piecearray(i).Interior.Color = 5287936 Then 'green
ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray1(i))).Select
With Selection.ShapeRange.Fill
.ForeColor.RGB = RGB(0, 176, 80)
End With
ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray2(i))).Select
With Selection.ShapeRange.Fill
.ForeColor.RGB = RGB(0, 176, 80)
End With

Псевдо код, эквивалентный

If Range.Interior.Color = 5287936 then
Triangle1.ForeColor.RGB = RGB(0, 176, 80)
Triangle2.ForeColor.RGB = RGB(0, 176, 80)
End If

Смысл RGB(0, 176, 80) оценивает = 5287936 мы могли бы просто сказать

 Triangle1.ForeColor.RGB = 5287936 
Triangle2.ForeColor.RGB = 5287936

Лучше работать с формой напрямую, а не через объект selection


Параметру activesheet.Формы.Диапазон(массив("прямоугольный треугольник" & trianglearray2(я))).РГБ = 5287936

Еще лучше будет для обоих форм сразу:


Параметру activesheet.Формы.Диапазон(массив("прямоугольный треугольник" & trianglearray1(я), "прямоугольный треугольник" & trianglearray2(я))).РГБ = 5287936

Другим вариантом было бы группы каждого куба треугольники вместе и ссылаться на них название группы:


Параметру activesheet.Формы("Фронт Куб 4").Заполнить.Свойство forecolor.РГБ = vbYellow

Проблема с использованием активных на выбор они целевые объекты ActiveSheet. Этого можно избежать путем полного указания ссылки:


Листы("Основной").Формы.Диапазон(массив("прямоугольный треугольник" & trianglearray1(я), "прямоугольный треугольник" & trianglearray2(я))).РГБ = 5287936

Часть , если заявление о том, что форматы куб Белый не должен быть разным.

    With Selection.ShapeRange.Fill
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
End With

Просто формат вашего диапазона.Интерьер.Цвет белый.


Диапазон.Интерьер.Цвет = vbWhite

Это позволит вам удалить , если заявление все вместе:

Worksheets("Main").Shapes.Range(Array("Right Triangle 1", "Right Triangle 3")).Fill.ForeColor.RGB = piecearray(i).Interior.Color 

А с заявлением, сделает его более удобным для чтения:

With Worksheets("Main").Shapes.Range(Array("Right Triangle 1", "Right Triangle 3"))
.Fill.ForeColor.RGB = piecearray(i).Interior.Color
End With

2
ответ дан 12 февраля 2018 в 01:02 Источник Поделиться