Showing posts with label scripting. Show all posts
Showing posts with label scripting. Show all posts

Friday, April 25

Koch Snowflake 3D_02

























The last script was built to assemble a one degree bigger 3D Koch Snowflake from a picked base flake. If you change the loop contained in it with this one here, you will have a randomly growing snowflake accumulation...! Also, I added a function preventing snowflakes from being copied in positions that are already occupied by other flakes.

If you'd like to try out increasing the max. i value, go ahead! - but I told you beware of your graphics RAM...

__
EnableRedraw (False)
'''''''''''''''''''''''''''''''''''''''''''''''
For i = 0 To 50
For j = 0 To 5
ReDim Preserve arrVec(n)
ReDim Preserve arrFlakes(n)
If i = 0 And (Rnd > 0.5) Then
arrVec(n) = PointAdd (arrFlakeBase, arrReloc(j))
arrFlakes(n) = CopyObject (strFlake0, arrFlakeBase, arrVec(n))
n = n + 1
ElseIf n >= 1 And (Rnd > 0.5) Then
arrVec(n) = PointAdd (arrVec(n-1), arrReloc(j))
If functOccupied (arrVec, n) = False Then
arrFlakes(n) = CopyObject (strFlake0, arrFlakeBase, arrVec(n))
n = n + 1
End If
End If
Next
Next
'''''''''''''''''''''''''''''''''''''''''''''''
EnableRedraw (True)


'''''''''''''''''''''''''''''''''''''''''''''''
Function functOccupied (arrVec, n)
Dim k
functOccupied = False

For k = 0 To Ubound (arrVec) - 1
If PointCompare (arrVec(k), arrVec(n)) = True Then
functOccupied = True
Exit For
End If
Next

End Function
'''''''''''''''''''''''''''''''''''''''''''''''


Monday, April 21

Koch Snowflake 3D_01


































Worked on a script that builds 3D Koch Snowflakes from a given Base-Flake (1°), here is what it looks like.
The key was to have the coordinates of the object's bounding box. The Flake fits perfectly in, it's extremities all touch the box at /2, /3 or /4 edge lengths... holy geometry!

There are some reasons why I decided to try the Koch Snowflake geometry:
It it sort of a 3D tiling pattern, it grows recursively, like a fractal, it consists of just one simple module (itself being built from 8 even tetrahedrons) and last but not least, I just loved the snowflake allusion!

___
Option Explicit
'written by cubic on April 21th, 2008
'pick 3D Koch Snowflake to build +1° bigger flake


Call Main
Sub Main

Dim strFlake0
Dim arrBBox
Dim BoxX, BoxY, BoxZ
Dim arrFlakeBase
Dim arrReloc(7)
Dim arrVec(7)
Dim arrFlakes(7)
Dim n : n = 0

strFlake0 = Rhino.GetObject ("Please pick a 3D Koch Snowflake")
arrBBox = Rhino.BoundingBox (strFlake0)


'''''''''''''''''''''''''''''''''''''''''''''''
'Calculate base point (arrFlakeBase) for picked strFlake0, from flake's Bounding Box.

BoxX = Rhino.Distance (arrBBox(0), arrBBox(1))
BoxY = Rhino.Distance (arrBBox(0), arrBBox(3))
BoxZ = Rhino.Distance (arrBBox(0), arrBBox(4))

arrFlakeBase = Rhino.PointAdd (arrBBox(0), Array(0, BoxY/4, BoxZ/3))


'''''''''''''''''''''''''''''''''''''''''''''''
'Calculate relocation vectors for copies of strFlake0.

arrReloc(0) = Array(BoxX, 0, 0)
arrReloc(1) = Array(BoxX/2, BoxY/4, BoxZ/1.5)
arrReloc(2) = Array(BoxX/2, -BoxY/4, BoxZ/3)
arrReloc(3) = Array(BoxX/2, BoxY*0.75, 0)
arrReloc(4) = Array(0, BoxY/2, BoxZ/3)
arrReloc(5) = Array(BoxX, BoxY/2, BoxZ/3)
arrReloc(6) = Array(BoxX/2, BoxY/4, -BoxZ/3)


'''''''''''''''''''''''''''''''''''''''''''''''
'Make copies of strFlake0 and move to new positions ...

For n = 0 To 6
arrVec(n) = Rhino.PointAdd (arrFlakeBase, arrReloc(n))
arrFlakes(n) = Rhino.CopyObject (strFlake0, arrFlakeBase, arrVec(n))
Next

End Sub

Thursday, March 13

pointcloud filling volume























This is somehow my first script, it plots random points into any picked solid (closed surface or polysurface).
To deal with the "any", the idea was to first draw the points into an enclosing volume and then decide whether they fit into the desired solid or not. I guess there are smarter ways to do it, so - something to keep thinking about:




Option Explicit
'written by philipp hoppe on March 13th, 2008
'plots random points within picked volume; points stored in array


Call Main
Sub Main

Dim strVolume
Dim arrPts()
Dim extX : extX = 20
Dim extY : extY = 20
Dim extZ : extZ = 20
Dim i
Dim n : n = 0

strVolume = Rhino.GetObject ("Pick a closed surface or polysurface", 8 + 16)

Rhino.EnableRedraw (False)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For i = 1 To 10000
ReDim Preserve arrPts(n)
arrPts(n) = Array(Rnd * extX, Rnd * extY, Rnd * extZ)

If Rhino.IsPointInSurface (strVolume, arrPts(n)) Then
Call Rhino.AddPoint (arrPts(n))
End If

n = n + 1
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Rhino.EnableRedraw (True)

End Sub