090730 -SHOW ME THE CODE!!!! (RVB) – attractor function

julio 30, 2009

4

OK, lets show the code!!!..

Function esfera (attr,k,mval,pa,pb,pc,pd,scale,i)

	Dim face
	Dim center
	Dim dist
	Dim esf
	Dim color
	face= rhino.addsrfpt (array(pa,pb,pc,pd))
	center= rhino.SurfaceAreaCentroid(face)

	ReDim dist (ubound(attr))
	Dim ptatr():ReDim ptatr (ubound(attr))

	For k=0 To ubound(attr)
		ptatr(k)= rhino.pointcoordinates(attr(k))
		dist(k)=rhino.Distance(ptatr(k),center(0))
	Next

	mval= rhino.min (dist)
	rhino.Print mval
	esf= rhino.AddSphere (center(0),(mval/scale))
	rhino.ObjectColor esf,rgb(255,i+(mval*5),133)
	rhino.ObjectColor face,rgb(255,i+(mval*5),133)

End Function
According to the recently attactor “fashion/porn” in the digital age (mainly grasshopper), i´m showing one of my first scripts in rhinoscript (2006). it’s an attractor function. Use, do wathever the f#$K!! you want with this function.
this was the core of my MAB-FPS code (https://escripto.wordpress.com/2008/07/01/080630_mab-fps-multi-attractor-based-flat-panel-skin/), a nice script for my thesis.
 i remember when i have to learn from zero rhinoscript, and other languages (mel for example), here in chile there was no one to ask for rhinoscript, only a few examples in the david rutten website. now, u go to a blog (like escripto) copy and paste the code, and you are suddenly a master of digital software!!, hahaha.

Just remember to name the origin of the code when u use it!!! eSCRIPT-O!!!

2

so, here´s the code…

Option Explicit
'Script written by <Diego Pinochet Puentes>
'Script copyrighted by <escripto.wordpress.com>
'Script version jueves, 17 de Octubre de 2006 10:32:33

' this is a code that i wrote to share, modify it , useit , and do whatever the fuck you want with it, but remember to name the author of the
'code. 

Call escripto()
Sub escripto()
	'counters for loop
	Dim i,j,k
	'get the surface
	Dim srf:srf= rhino.getobject("select surface",8)
	If isNull(srf) Then Exit Sub

	'get the atractors
	Dim arrpt
	Dim attr:attr= rhino.getobjects ("select the atractors",1)
	Dim arrbox:arrbox = Rhino.PropertyListBox(array("step U","step  V","attractor force"),array(10,10,12.5))
	If isNull(arrbox) Then Exit Sub

	Dim udiv:udiv= CInt(arrbox(0))
	Dim vdiv:vdiv= CInt(arrbox(1))
	Dim scale:scale= CDbl(arrbox(2))

	Dim arrparamu,arrparamv
	Dim arrdomainu, arrdomainv

	ReDim mat(udiv,vdiv)

	'get uv parameters
	arrdomainu= rhino.surfacedomain(srf,0)
	arrdomainV= rhino.SurfaceDomain(srf,1)

	For i=0 To udiv
		For j=0 To vdiv
			arrparamU = arrdomainU(0) + i *(arrdomainU(1) - arrdomainU(0)) /udiv
			arrparamV = arrdomainV(0) + j *(arrdomainV(1) - arrdomainV(0)) / vdiv 

			arrpt= rhino.EvaluateSurface (srf,Array(arrParamU, arrParamV))
			mat(i,j) = arrpt
		Next
	Next

	Dim mval
	Dim pa,pb,pc,pd

	For i=0 To udiv-1
		For j=0 To vdiv-1 

			pa= mat(i,j)
			pb= mat(i,j+1)
			pc= mat(i+1,j+1)
			pd= mat(i+1,j)
			'calll function for attractors
			Dim a:a= esfera (attr,k,mval,pa,pb,pc,pd,scale,i)
		Next
	Next
End Sub

Function esfera (attr,k,mval,pa,pb,pc,pd,scale,i)

	Dim face
	Dim center
	Dim dist
	Dim esf
	Dim color

	face= rhino.addsrfpt (array(pa,pb,pc,pd))
	center= rhino.SurfaceAreaCentroid(face)

	ReDim dist (ubound(attr))
	Dim ptatr():ReDim ptatr (ubound(attr))

	For k=0 To ubound(attr)
		ptatr(k)= rhino.pointcoordinates(attr(k))
		dist(k)=rhino.Distance(ptatr(k),center(0))
	Next

	mval= rhino.min (dist)
	rhino.Print mval
	esf= rhino.AddSphere (center(0),(mval/scale))
	rhino.ObjectColor esf,rgb(255,i+(mval*5),133)
	rhino.ObjectColor face,rgb(255,i+(mval*5),133)

End Function

Option Explicit
‘Script written by <Diego Pinochet Puentes>
‘Script copyrighted by <escripto.wordpress.com>
‘Script version jueves, 17 de Octubre de 2006 10:32:33
‘ this is a code that i wrote to share, modify it , useit , and do whatever the fuck you want with it, but remember to name the author of the
‘code.
Call Main()
Sub Main()
 Dim i,j,k
 Dim srf:srf= rhino.getobject(“select surface”,8)
 If isNull(srf) Then Exit Sub
 
 Dim arrpt
 Dim attr:attr= rhino.getobjects (“select the atractors”,1)
 Dim arrbox:arrbox = Rhino.PropertyListBox(array(“step U”,”step  V”,”attractor force”),array(10,10,12.5))
 If isNull(arrbox) Then Exit Sub
 
 Dim udiv:udiv= CInt(arrbox(0))
 Dim vdiv:vdiv= CInt(arrbox(1))
 Dim scale:scale= CDbl(arrbox(2))
 
 Dim arrparamu,arrparamv
 Dim arrdomainu, arrdomainv
 
 ReDim mat(udiv,vdiv)
 
arrdomainu= rhino.surfacedomain(srf,0)
arrdomainV= rhino.SurfaceDomain(srf,1)
For i=0 To udiv
For j=0 To vdiv
arrparamU = arrdomainU(0) + i *(arrdomainU(1) – arrdomainU(0)) /udiv
arrparamV = arrdomainV(0) + j *(arrdomainV(1) – arrdomainV(0)) / vdiv
arrpt= rhino.EvaluateSurface (srf,Array(arrParamU, arrParamV))
mat(i,j) = arrpt
Next
Next
Dim mval
Dim pa,pb,pc,pd
For i=0 To udiv-1
For j=0 To vdiv-1
pa= mat(i,j)
pb= mat(i,j+1)
pc= mat(i+1,j+1)
pd= mat(i+1,j)
Dim a:a= esfera (attr,k,mval,pa,pb,pc,pd,scale,i)
Next
Next
End Sub
Function esfera (attr,k,mval,pa,pb,pc,pd,scale,i)
Dim face
Dim center
Dim dist
Dim esf
Dim color
face= rhino.addsrfpt (array(pa,pb,pc,pd))
center= rhino.SurfaceAreaCentroid(face)
ReDim dist (ubound(attr))
Dim ptatr():ReDim ptatr (ubound(attr))
For k=0 To ubound(attr)
ptatr(k)= rhino.pointcoordinates(attr(k))
dist(k)=rhino.Distance(ptatr(k),center(0))
Next
mval= rhino.min (dist)
rhino.Print mval
esf= rhino.AddSphere (center(0),(mval/scale))
rhino.ObjectColor esf,rgb(255,i+(mval*5),133)
rhino.ObjectColor face,rgb(255,i+(mval*5),133)
End Function
Anuncios

Una respuesta to “090730 -SHOW ME THE CODE!!!! (RVB) – attractor function”

  1. grisch Says:

    Thanks Diego… Open Source = Good Karma, in a very Pythonic way. Nice work !!


Responder

Introduce tus datos o haz clic en un icono para iniciar sesión:

Logo de WordPress.com

Estás comentando usando tu cuenta de WordPress.com. Cerrar sesión / Cambiar )

Imagen de Twitter

Estás comentando usando tu cuenta de Twitter. Cerrar sesión / Cambiar )

Foto de Facebook

Estás comentando usando tu cuenta de Facebook. Cerrar sesión / Cambiar )

Google+ photo

Estás comentando usando tu cuenta de Google+. Cerrar sesión / Cambiar )

Conectando a %s

A %d blogueros les gusta esto: