Membuat Bentuk 3D dengan Visual Basic

Buat form seperti di bawah ini .

form

Klik 2 kali pada form tersebut dan ketikkan kode berikut pada kode editor.

Private Sub Form_Load()
With Me
.WindowState = 2
.BackColor = vbBlack
.ForeColor = vbWhite
.Caption = "Bentuk 3D"
.Show
End With

y = 4000
x = 6000
R_poligon = 100
Me_to_obj = 10000
Obj_to_me = 1000
BuatPoligon
arrayGambar objek
putar objek, 0, -pi / 2
bentuk
End Sub

Lalu tambahkan module di Project – Add Module .  Lalu kettikkan kode di bawah ini pada module editor.


Option Explicit
Public Const pi = 3.1415926
Public Const sudutN = 5
Public Const DiameterLing = 6000
Type dot
 x As Double
 y As Double
 z As Double
End Type

Public objek(1 To sudutN + 1) As dot
Public bola_H, bola_V
Public x, y, z
Public Me_to_obj
Public Obj_to_me
Public R_poligon
Public sudutPutar As Double

Function crad(deg)
crad = deg * pi / 180
End Function

Function cdeg(rad)
cdeg = rad * pi / 180
End Function

Public Sub BuatPoligon()
Dim sudut
Dim n As Double
sudut = 360 / sudutN
For n = 1 To UBound(objek())
objek(n).x = Sin(crad(202.5 + (n - 1) * sudut)) * R_poligon
objek(n).y = Cos(crad(202.5 + (n - 1) * sudut)) * R_poligon
objek(n).z = DiameterLing / 2
Next n
n = 1 - ((R_poligon * 2) ^ 2) / (2 * ((DiameterLing / 2) ^ 2))
n = n ^ 2
n = Sqr(1 / n - 1)
sudutPutar = Atn(n)

End Sub

Public Sub putar(obj() As dot, sudutH, sudutV)
Dim x, y, z, c As Double
Dim sudutHorizontal, sudutVertikal As Double
sudutHorizontal = sudutH + crad(bola_H)
sudutVertikal = sudutV + crad(bola_V)
For c = 1 To UBound(obj())
If sudutHorizontal <> 0 Then
 x = obj(c).x
 y = obj(c).y
 z = obj(c).z
 obj(c).z = z * Cos(sudutHorizontal) - x * Sin(sudutHorizontal)
 obj(c).x = x * Cos(sudutHorizontal) + z * Sin(sudutHorizontal)
End If

If sudutVertikal <> 0 Then
 x = obj(c).x
 y = obj(c).y
 z = obj(c).z
 obj(c).y = y * Cos(sudutVertikal) - z * Sin(sudutVertikal)
 obj(c).z = z * Cos(sudutVertikal) + y * Sin(sudutVertikal)
End If
Next c
End Sub

Public Sub arrayGambar(obj() As dot)
On Error Resume Next
Dim n, d, dz
Dim r, x1, y1, x2, y2
d = Me_to_obj
dz = d + Obj_to_me
x2 = (obj(1).x) * d / (obj(1).z + dz) + x
y2 = (obj(1).y) * d / (obj(1).z + dz) + y
For n = 0 To UBound(obj()) - 1
 x1 = x2
 y1 = y2
 x2 = (obj(n + 1).x) * d / (obj(n + 1).z + dz) + x
 y2 = (obj(n + 1).y) * d / (obj(n + 1).z + dz) + y
If (obj(n + 1).z < 0) Then Form1.Line (x1, y1)-(x2, y2)
Next n
End Sub

Public Sub bentuk()
Form1.Cls
Dim h, v, a, n
a = sudutPutar
n = Val(2 * pi / sudutPutar)
For h = 1 To n / 2
 For v = 1 To n
 arrayGambar objek
 putar objek, a, 0
 Next v
 putar objek, 0, a
Next h
End Sub

Setelah itu tekan F5 atau Run dan hasilnya terlihat seperti di bawah ini😉

bola

Download  source code🙂

6 Responses to “Membuat Bentuk 3D dengan Visual Basic”


  1. 1 Arya Maret 13, 2010 pukul 3:58 pm

    Koq ga bisa ya? Apa ada yang salah?
    Btw makasih banyak sharing ilmunya, gw ga paham bgt pemrograman. Semoga bisa terus membantu ya. Makasih.

  2. 2 Liroesdy Maret 15, 2010 pukul 9:22 am

    Mungkin waktu ngetik kode-kodenya ada yang terlewat atau hurufnya adanya besar / kecil (case sensitif ). sebelumnya waktu saya nyoba juga kadang error kadang sukses, mungkin karena kebanyakan baris kodenya😛

    Tapi nanti saya coba lagi dech dirumah, kalau ada yang salah, saya koreksi🙂

    • 3 david Juli 7, 2010 pukul 8:33 am

      koq waktu di ktik .caption………..koq ada yg error….?
      thank’s before…

      • 4 epi inside September 2, 2011 pukul 10:25 am

        karakter “, kalo di html emg gtu jd berubah
        GUE BS nih tlg d betulin,jd gini :

        DI FORM PROCEDURE (baris 6)
        .Caption = “Bentuk 3D”

        DI module
        (baris 49)
        If sudutHorizontal 0 Then
        (baris 57)
        If If sudutVertikal 0 Then
        (baris 80)
        If (obj(n + 1).z < 0) Then Form1.Line (x1, y1)-(x2, y2)

      • 5 epi inside September 2, 2011 pukul 10:28 am

        karakter “, kalo di html emg gtu jd berubah
        GUE BS nih tlg d betulin,jd gini :

        DI FORM PROCEDURE (baris 6)
        .Caption = “Bentuk 3D”

        DI module
        (baris 49)
        If sudutHorizontal 0 Then
        (baris 57)
        If If sudutVertikal 0 Then
        (baris 80)
        If (obj(n + 1).z < 0) Then Form1.Line (x1, y1)-(x2, y2)

  3. 6 epi inside September 2, 2011 pukul 10:33 am

    wah kok g keluar tuh di posting gue :
    d baris 49 n 57 sebelum angka 0 tlg kasih tanda “kurang lebih”
    “”


Tinggalkan Balasan

Isikan data di bawah atau klik salah satu ikon untuk log in:

Logo WordPress.com

You are commenting using your WordPress.com account. Logout / Ubah )

Gambar Twitter

You are commenting using your Twitter account. Logout / Ubah )

Foto Facebook

You are commenting using your Facebook account. Logout / Ubah )

Foto Google+

You are commenting using your Google+ account. Logout / Ubah )

Connecting to %s




Me (^^)

About

Blog ini adalah catatan kuliah ku, tidak hanya mengenai materi kuliah tetapi juga tentang kegiatan, pengalaman aku selama kuliah :) .


=-=-=-=-=
image header = "Byousoku 5 cm " with edited :)

Liroesdy on Net (=^_^=)

Blog Stats

  • 59,078 hits
Click to view my 

Personality Profile page

My Personal Blog

Liroesdy Blog

Liroesdy Lab

Liroesdy Lab

%d blogger menyukai ini: