Don't have an account yet? Register

# A 3D Sphere

by Boriza (1 Submission)
Category: Math/Dates
Compatability: Visual Basic 3.0
Difficulty: Unknown Difficulty
Date Added: Wed 3rd February 2021

Draw a real 3D shpere using ONLY lines. This code can be easily modified to show other 3D objects. All you need to do is an array of coordinates. It does everything else for you (display, rotation, zoom etc) HAVE YOUR PERSONAL 3D ENGINE!!!

Inputs
'Try to change: ' number of angles and size of the polygon 'Also: Size of the sphere
Assumes
Just create form (form1), module and PASTE the code! This code rotates a polygon to create a sphere.
Side Effects
It does not always draw a full sphere, may be you can fix it...
API Declarations
`Option ExplicitPublic Const Pi = 3.1415926'Number of angles of polygonPublic Const N_Angles = 5'Diameter of the spherePublic Const Sphere_Diam = 6000Type Dot X As Double Y As Double Z As DoubleEnd Type'polygon in arrayPublic Object(1 To N_Angles + 1) As DotPublic H_Globe, V_GlobePublic X, Y, ZPublic Me_to_ObjPublic Obj_to_MePublic Polygon_RPublic Turn_Angle As DoubleFunction CRad(Deg)'convert deg to rad CRad = Deg * Pi / 180End FunctionFunction CDeg(Rad) CDeg = Rad * 180 / PiEnd FunctionPublic Sub GenPolygon()'generate polygon Dim Angle Dim n As Double Angle = 360 / N_Angles For n = 1 To UBound(Object()) Object(n).X = Sin(CRad(202.5 + (n - 1) * Angle)) * Polygon_R Object(n).Y = Cos(CRad(202.5 + (n - 1) * Angle)) * Polygon_R Object(n).Z = Sphere_Diam / 2 Next n n = 1 - ((Polygon_R * 2) ^ 2) / (2 * ((Sphere_Diam / 2) ^ 2)) n = n ^ 2 n = Sqr(1 / n - 1) Turn_Angle = Atn(n)End SubPublic Sub Rotate(Obj() As Dot, HAngle, VAngle)'this function rotates dots in array around the axes Dim X, Y, Z, c As Double Dim Ha, Va As Double Ha = HAngle + CRad(H_Globe) Va = VAngle + CRad(V_Globe) For c = 1 To UBound(Obj()) If Ha <> 0 Then X = Obj(c).X Y = Obj(c).Y Z = Obj(c).Z Obj(c).Z = Z * Cos(Ha) - X * Sin(Ha) Obj(c).X = X * Cos(Ha) + Z * Sin(Ha) End If If Va <> 0 Then X = Obj(c).X Y = Obj(c).Y Z = Obj(c).Z Obj(c).Y = Y * Cos(Va) - Z * Sin(Va) Obj(c).Z = Z * Cos(Va) + Y * Sin(Va) End If Next cEnd SubPublic Sub DrawArray(Obj() As Dot)'display array of dots on the screen'Note: all dots are connected by linesOn 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 'Swap next 2 lines to get full sphere: 'Form1.Line (X1, Y1)-(X2, Y2) If Obj(n + 1).Z < 0 Then Form1.Line (X1, Y1)-(X2, Y2) Next n End SubPublic Sub Sphere()'Displays polygons under different angles to construct a sphereForm1.Cls Dim H, V, A, n A = Turn_Angle n = Val(2 * Pi / Turn_Angle) For H = 1 To n / 2 For V = 1 To n DrawArray Object Rotate Object, A, 0 Next V Rotate Object, 0, A Next HEnd Sub`

Rate A 3D Sphere

`Option ExplicitPrivate Sub Form_Load()Me.WindowState = 2Me.BackColor = vbBlackMe.ForeColor = vbWhiteMe.Caption = "3D Sphere - Your own 3D engine!               Programed by BORIZA"Me.Show'Position of sphere on the screenY = 4000X = 6000'Size of a polygon:Polygon_R = 100'Distance of the object from youMe_to_Obj = 10000Obj_to_Me = 1000GenPolygonDrawArray ObjectRotate Object, 0, -Pi / 2SphereEnd Sub`

Subject:
Message:
0/1000 characters