想画个魔方

dongdonggege

tspliu 发表于 2023-2-28 10:44
近大，远小，不能画成平行四边行，梯形看上去才正常

不知道额，我的代码在7楼，另外，我已专门发了代码，程序正在审核。麻烦帮我修改下，图形看的不自然。

morpheus126

dongdonggege 发表于 2023-2-27 20:04
请你画一个

我这也是不符合透视的~

dongdonggege

horselyq 发表于 2023-2-28 08:30
https://www.geogebra.org/m/yezd5aps

老师，不好意思，没注意到老师的文章，好像是魔方的解法。解法，我会。怎么画图的？我不会，你给我的是网页版，盼老师给VBA方法，谢谢。

tanglf188

插入联机图片

dongdonggege

tanglf188 发表于 2023-3-13 10:25
插入联机图片

你别贴图片，你贴下你的程序啊。

dongdonggege

tanglf188 发表于 2023-3-13 10:25
插入联机图片

无论你是PowerPoint、Word、Excel的，都行啊，道理都是想通的。

perfect131

直接白嫖他的

dongdonggege

perfect131 发表于 2023-3-13 13:30
直接白嫖他的

那就谢谢你了。

ZHLK

Sub 宏1(x0, y0, x远点, y远点, h)
    For Each shp In ActiveSheet.Shapes
        If shp.Name <> "CommandButton1" And shp.Name <> "SpinButton1" Then
            shp.Delete
        End If
    Next
   
x0 = Cells(1, 2)
y0 = Cells(2, 2)
x远点 = Cells(3, 2)
y远点 = Cells(4, 2)
h = Cells(5, 2)
n = 1
x1 = x0
y1 = y0
For i = 1 To 4
    For j = 1 To 4
        With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, x1, y1)
            .AddNodes msoSegmentLine, msoEditingAuto, x1 + h, y1
            .AddNodes msoSegmentLine, msoEditingAuto, x1 + h, y1 + h
            .AddNodes msoSegmentLine, msoEditingAuto, x1, y1 + h
            .AddNodes msoSegmentLine, msoEditingAuto, x1, y1
            .ConvertToShape.Select
        End With
        宏2 (n Mod 2)
        n = n + 1
        x1 = x1 + h
    Next
    n = n - 1
    y1 = y1 + h
    x1 = x0
Next

n = 2
x1 = x0
y1 = y0
For i = 1 To 4
    With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, x1, y1)
        .AddNodes msoSegmentLine, msoEditingAuto, x远点, y远点
        .AddNodes msoSegmentLine, msoEditingAuto, x1 + h, y1
        .AddNodes msoSegmentLine, msoEditingAuto, x1, y1
        .ConvertToShape.Select
    End With
    宏2 (n Mod 2)
    n = n + 1
    x1 = x1 + h
Next
n = 1
For i = 1 To 4
    With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, x1, y1)
        .AddNodes msoSegmentLine, msoEditingAuto, x远点, y远点
        .AddNodes msoSegmentLine, msoEditingAuto, x1, y1 + h
        .AddNodes msoSegmentLine, msoEditingAuto, x1, y1
        .ConvertToShape.Select
    End With
    宏2 (n Mod 2)
    n = n + 1
    y1 = y1 + h
Next
Range("a1").Select

End Sub
Sub 宏2(i As Integer)
If i = 1 Then
    Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 176, 80)
Else
    Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
End If
   
End Sub