如何用line画一个立体方块？？？？

Question

如题，100分相送！
   
   /\
  /  \ 
 /    \
|\     \ 
| \    /| 
\  \  / |
 \  \/ /
  \ | /
   \|/

Answer 1

Private Function Draw3D(ByRef DrawObj As Object, ByVal Height As Long)
    '画一个立方体
    'DrawObj - 支持Line方法的对象,窗体,图片框等
    'Height - 指定立方体高度
    Dim Line1(4) As LineXY
    Dim I As Long
    
    DrawObj.ScaleMode = 3   '设置为像素
    
    With Line1(1)       '这里的坐标指定立方体形状
        .X = 350
        .Y = 80
    End With
    With Line1(2)
        .X = 230
        .Y = 160
    End With
    With Line1(3)
        .X = 80
        .Y = 100
    End With
    With Line1(4)
        .X = 200
        .Y = 30
    End With
    For I = 1 To 4
        With Line1(I)
            DrawObj.Line (.X, .Y)-(.X, .Y + Height)
        End With
        DrawObj.Line (Line1(I).X, Line1(I).Y)-(Line1(IIf(I = 4, 1, I + 1)).X, Line1(IIf(I = 4, 1, I + 1)).Y)
        DrawObj.Line (Line1(I).X, Line1(I).Y + Height)-(Line1(IIf(I = 4, 1, I + 1)).X, Line1(IIf(I = 4, 1, I + 1)).Y + Height)
    Next I
End Function调用:Call Draw3D(Me,160)参数要自己调整啦.

Answer 2

请问楼上的
Dim Line1(4) As LineXY
这个LineXY是什么东东？？？？

Answer 3

Private Sub Form_click()
Dim x As Single, y As Single, l As Single
Me.AutoRedraw = True
Me.Cls
Me.DrawStyle = 0
Randomize
x = 3000 * Rnd(): y = 3000 * Rnd(): l = 1000
Me.Line (x, y)-(x, y + l), vbGreen
Me.Line -(x + l, y + l), vbGreen
Me.Line -(x + l, y), vbGreen
Me.Line -(x, y), vbGreenMe.Line (x, y)-(x + 1 / 2 * l, y - 1 / 2 * l), vbGreen
Me.Line -(x + 1 / 2 * l + l, y - 1 / 2 * l), vbGreen
Me.Line -(x + l, y), vbGreenMe.Line (x + 1 / 2 * l + l, y - 1 / 2 * l)-(x + 1 / 2 * l + l, y - 1 / 2 * l + l), vbGreen
Me.Line -(x + l, y + l), vbGreen
Me.DrawStyle = 1
Me.Line (x, y + l)-(x + 1 / 2 * l, y + l - 1 / 2 * l), vbGreen
Me.Line -(x + 1 / 2 * l, y - 1 / 2 * l), vbGreen
Me.Line (x + 1 / 2 * l, y + l - 1 / 2 * l)-(x + l + 1 / 2 * l, y + l - 1 / 2 * l), vbGreenEnd Sub

Answer 4

忘了这个结构:Private Type LineXY
    X As Long
    Y As Long
End Type其实就是API里的那个POINTAPI,只不过我换成了LONG

Answer 5

向zzyong00(阿勇) 学习!数学学得不错!我只想到了全由他自己定义........还要多多努力>_<

Answer 6

myjian大大，您的程序非常强，可不可再改进一下，函数里可否再加个 长、宽 这两个参数呢？

Answer 7

先上班..........不然被扣钱.........晚上再来.....zzyong00(阿勇) 比我更强....

Answer 8

zzyong00(阿勇) 前面的线可惜是直的

Answer 9

改进的函数Draw3D(需要两个辅助函数):Private Function Draw3D(ByRef DrawObj As Object, ByVal Height As Long, ByVal mLen As Long, ByVal mAngle1 As Long, ByVal mAngle2 As Long)
    '画一个立方体
    'DrawObj - 支持Line方法的对象,窗体,图片框等
    'Height - 指定立方体高度
    'mLen - 立方体边长
    'mAngle1 - 立方体最左下边与水平线间的角度(平面角度,非3D状态....)
    'mAngle2 - 立方体最左上边与水平线间的角度(平面角度,非3D状态....)
    Dim Line1(4) As LineXY
    Dim I As Long
    Dim tmpX As Long, tmpY As Long
    
    DrawObj.ScaleMode = 3   '设置为像素
    
    With Line1(1)       '这里的坐标指定立方体形状
        .X = 350
        .Y = 80
        tmpX = .X - mLen
        tmpY = .Y
        Call GetXY(tmpX, tmpY, .X, .Y, -mAngle1)
    End With
    With Line1(2)
        .X = tmpX
        .Y = tmpY
        tmpX = .X
        tmpY = .Y - mLen
        Call GetXY(tmpX, tmpY, .X, .Y, -(90 - mAngle2))
    End With
    With Line1(3)
        .X = tmpX
        .Y = tmpY
        tmpX = .X + mLen
        tmpY = .Y
        Call GetXY(tmpX, tmpY, .X, .Y, -mAngle1)
    End With
    With Line1(4)
        .X = tmpX
        .Y = tmpY
    End With
    
    For I = 1 To 4
        With Line1(I)
            DrawObj.Line (.X, .Y)-(.X, .Y + Height)
        End With
        DrawObj.Line (Line1(I).X, Line1(I).Y)-(Line1(IIf(I = 4, 1, I + 1)).X, Line1(IIf(I = 4, 1, I + 1)).Y)
        DrawObj.Line (Line1(I).X, Line1(I).Y + Height)-(Line1(IIf(I = 4, 1, I + 1)).X, Line1(IIf(I = 4, 1, I + 1)).Y + Height)
    Next I
End FunctionPrivate Function GetXY(ByRef X As Long, ByRef Y As Long, ByVal Xo As Long, ByVal Yo As Long, ByVal mAngle As Long)
    '计算以指定点为圆心时,某点偏转某角度后的相对偏转坐标
    'X - 偏转前点X(输出偏转后点X)
    'Y - 偏转前点Y(输出偏转后点Y)
    'Xo - 顶点坐标X
    'Yo - 顶点坐标Y
    'mAngle - 偏转角度
    Dim Js As Double
    Dim Jz As Double
    Dim L As Double
    
    L = Sqr((Xo - X) ^ 2 + (Yo - Y) ^ 2)
    Js = GetAngle(X, Y, Xo, Yo)
    Jz = Js + mAngle
    Do While Jz < 0
        Jz = Jz + 360
    Loop
    Do While Jz > 360
        Jz = Jz - 360
    Loop
    
    Jz = Jz * pi / 180
    
    X = L * Cos(Jz) + Xo
    Y = L * Sin(Jz) + Yo
End FunctionPublic Function GetAngle(ByVal X As Double, ByVal Y As Double, ByVal Rx As Double, ByVal Ry As Double) As Double
    '返回指定点与指定圆心间夹角
    'X - 指定点X
    'Y - 指定点Y
    'Rx - 假想圆心X
    'Ry - 假想圆心Y
    '返回值 - 角度
    Dim Xo As Double
    Dim Yo As Double
    
    Xo = X - Rx
    Yo = Y - Ry
    If Xo <> 0 Then
        GetAngle = Atn(-Yo / Xo) * 180 / pi
    Else
        If Yo > 0 Then
           GetAngle = 90
        Else
           GetAngle = 270
        End If
        Exit Function
    End If
    
    If GetAngle > 0 Then
       If Xo > 0 Then
          GetAngle = 360 - GetAngle
       Else
          GetAngle = 180 - GetAngle
       End If
    ElseIf GetAngle < 0 Then
       If Xo > 0 Then
          GetAngle = -GetAngle
       Else
          GetAngle = 180 - GetAngle
       End If
    Else
       If Xo < 0 Then
          GetAngle = 180
       Else
          GetAngle = 0
       End If
    End If
End Function

Answer 10

调用:Call Draw3D(Me, 160, 160, 10, 20)说明一下,最后两个参数决定了立方体的形状.哎,睡觉..............一点了

Answer 11

fankun(@BrokenWorld我是上帝的玩偶@) ( ) 信誉：100    Blog   加为好友  2007-05-09 12:52:42  得分: 0  
 
 
   听说老马是单身啊，忙得找老婆的时间都没了。各位兄弟多留心。
单身精力就是旺盛。呵呵。。
  
// 
...............等等你从哪里"听说"来的??

Answer 12

上次看mMM的照片，你不是还一声叹息，说自己单身的吗？？？

Answer 13

请问 myjian(嗷嗷叫的老马--好好洗澡,天天搓甲~~~~~~~~~~~~~~~) 
打印在 A4的纸张上ScaleMode 应该为什么????
还用 DrawObj.ScaleMode = 3   '设置为像素 
可以不>?

Answer 14

得试试.........我没玩过打印机..   -_-bbbbbbbbbbbbbbbbbb

Answer 15

TO  
 myjian(嗷嗷叫的老马)：你的习惯不好，应该加上：“ Option Explicit ”

Answer 16

而且你那改进的函数 在：“GetAngle = Atn(-Yo / Xo) * 180 / pi”这里发生溢出。你太有才了

Answer 17

你的习惯不好，应该加上：“ Option Explicit ”//我发的是函数......如何在函数内加Option Explicit ?烦请告知一下..........//
而且你那改进的函数 在：“GetAngle = Atn(-Yo / Xo) * 180 / pi”这里发生溢出。你太有才了
//谢谢指出我的错误,我从小学开始数学就不好....不过在我这里真没有发生过溢出....还烦请LS帮忙改进....但不知道如此讽刺我,是因为我以前在哪里有得罪过你?没错,我只是一个中专没毕业的电工,但我觉得我做人还算可以吧....应该不至于在哪里把这位博士大哥给得罪罗....?

Answer 18

这里有源码，你可以看看：
三围立方体
http://www.egooglet.com/static_html/200511092134489897admin.html
旋转立方体
http://www.egooglet.com/static_html/200511092139174367admin.html

Answer 19

总结下新建一窗体,复制以下代码后直接F5:Option ExplicitPrivate Type LineXY
    X As Long
    Y As Long
End TypePrivate Const PI = 3.14159265Private Function Draw3D(ByRef DrawObj As Object, ByVal Height As Long, ByVal mLen As Long, ByVal mAngle1 As Long, ByVal mAngle2 As Long)
    '画一个立方体
    'DrawObj - 支持Line方法的对象,窗体,图片框等
    'Height - 指定立方体高度
    'mLen - 立方体边长
    'mAngle1 - 立方体最左下边与水平线间的角度(平面角度,非3D状态....)
    'mAngle2 - 立方体最左上边与水平线间的角度(平面角度,非3D状态....)
    Dim Line1(4) As LineXY
    Dim I As Long
    Dim tmpX As Long, tmpY As Long
    
    DrawObj.ScaleMode = 3   '设置为像素
    
    With Line1(1)       '这里的坐标指定立方体形状
        .X = 350
        .Y = 80
        tmpX = .X - mLen
        tmpY = .Y
        Call GetXY(tmpX, tmpY, .X, .Y, -mAngle1)
    End With
    With Line1(2)
        .X = tmpX
        .Y = tmpY
        tmpX = .X
        tmpY = .Y - mLen
        Call GetXY(tmpX, tmpY, .X, .Y, -(90 - mAngle2))
    End With
    With Line1(3)
        .X = tmpX
        .Y = tmpY
        tmpX = .X + mLen
        tmpY = .Y
        Call GetXY(tmpX, tmpY, .X, .Y, -mAngle1)
    End With
    With Line1(4)
        .X = tmpX
        .Y = tmpY
    End With
    
    For I = 1 To 4
        With Line1(I)
            DrawObj.Line (.X, .Y)-(.X, .Y + Height)
        End With
        DrawObj.Line (Line1(I).X, Line1(I).Y)-(Line1(IIf(I = 4, 1, I + 1)).X, Line1(IIf(I = 4, 1, I + 1)).Y)
        DrawObj.Line (Line1(I).X, Line1(I).Y + Height)-(Line1(IIf(I = 4, 1, I + 1)).X, Line1(IIf(I = 4, 1, I + 1)).Y + Height)
    Next I
End FunctionPrivate Function GetXY(ByRef X As Long, ByRef Y As Long, ByVal Xo As Long, ByVal Yo As Long, ByVal mAngle As Long)
    '计算以指定点为圆心时,某点偏转某角度后的相对偏转坐标
    'X - 偏转前点X(输出偏转后点X)
    'Y - 偏转前点Y(输出偏转后点Y)
    'Xo - 顶点坐标X
    'Yo - 顶点坐标Y
    'mAngle - 偏转角度
    Dim Js As Double
    Dim Jz As Double
    Dim L As Double
    
    L = Sqr((Xo - X) ^ 2 + (Yo - Y) ^ 2)
    Js = GetAngle(X, Y, Xo, Yo)
    Jz = Js + mAngle
    Do While Jz < 0
        Jz = Jz + 360
    Loop
    Do While Jz > 360
        Jz = Jz - 360
    Loop
    
    Jz = Jz * PI / 180
    
    X = L * Cos(Jz) + Xo
    Y = L * Sin(Jz) + Yo
End FunctionPublic Function GetAngle(ByVal X As Double, ByVal Y As Double, ByVal Rx As Double, ByVal Ry As Double) As Double
    '返回指定点与指定圆心间夹角
    'X - 指定点X
    'Y - 指定点Y
    'Rx - 假想圆心X
    'Ry - 假想圆心Y
    '返回值 - 角度
    Dim Xo As Double
    Dim Yo As Double
    
    Xo = X - Rx
    Yo = Y - Ry
    If Xo <> 0 Then
        GetAngle = Atn(-Yo / Xo) * 180 / PI
    Else
        If Yo > 0 Then
           GetAngle = 90
        Else
           GetAngle = 270
        End If
        Exit Function
    End If
    
    If GetAngle > 0 Then
       If Xo > 0 Then
          GetAngle = 360 - GetAngle
       Else
          GetAngle = 180 - GetAngle
       End If
    ElseIf GetAngle < 0 Then
       If Xo > 0 Then
          GetAngle = -GetAngle
       Else
          GetAngle = 180 - GetAngle
       End If
    Else
       If Xo < 0 Then
          GetAngle = 180
       Else
          GetAngle = 0
       End If
    End If
End FunctionPrivate Sub Form_Load()
    Me.Show
    Call Draw3D(Me, 180, 180, 20, 15)
End Sub