Older VB-scripts running in GH

Replies to This Discussion

Permalink Reply by Luis Fraguada on May 3, 2011 at 8:21am

Can you show us an example of the script you are trying to use?  Sounds like Rhinoscript...

Permalink Reply by Peter Mayrhofer on May 3, 2011 at 9:51am

The scripts were written in the Rhino scripting editor. Here an example:

Option Explicit
'==================================================
'Test eines Vierecks im Raum auf Planarität
'Berechnung des Winkels bei Zerlegung in 2 Dreiecke
'Zeichnen der Zerlegung nach dem kleineren Winkel
'Eingabe: 4 Punkte im Raum 
'Peter Mayrhofer 05-2007
'==================================================
Sub Main()
  Dim arrPts 'Array der 4 Eingabepunkte
  Dim arrN1, arrN2 'Normalvektoren einer Zerlegung in 2 Dreiecke
  Dim winkel1, winkel2, wmin, wmax 'Winkel bei gemeinsamer Kante
  Dim pi, grad
  pi = 4*Atn(1): grad = 180/pi
 'Eingabe
  arrPts = GetPoints(,, "4 Punkte eingeben..." ,, 4)'Punkte 0,1,2,3 
 'Berechnung Winkel1 bei Zerlegung mit gemeinsamer Kante [1,3]
  arrN1 = VectorUnitize(VectorCrossProduct(VectorCreate(arrPts(0), arrPts(1)),VectorCreate(arrPts(0), arrPts(3))))
  arrN2 = VectorUnitize(VectorCrossProduct(VectorCreate(arrPts(2), arrPts(3)),VectorCreate(arrPts(2), arrPts(1))))
  If VectorCompare (arrN1, arrN2) Then
     winkel1 = 180 'Das Viereck ist planar!
     MessageBox "*Viereck ist planar*"
     Exit Sub
  Else
    winkel1 = Arccos(VectorDotProduct(arrN1, arrN2))*grad
  End If
 'Berechnung Winkel2 bei Zerlegung mit gemeinsamer Kante [0,2]
  arrN1 = VectorUnitize(VectorCrossProduct(VectorCreate(arrPts(1), arrPts(2)),VectorCreate(arrPts(1), arrPts(0))))
  arrN2 = VectorUnitize(VectorCrossProduct(VectorCreate(arrPts(3), arrPts(0)),VectorCreate(arrPts(3), arrPts(2))))
  winkel2 = Arccos(VectorDotProduct(arrN1, arrN2))*grad
 'Winkelvergleich und Ausgabemeldung
  If winkel1 <= winkel2 Then
     wmin = winkel1 : wmax = winkel2
     AddLine arrPts(0), arrPts(2) 'Dreieckszerlegung bei kleinerem Winkel
  Else
     wmin = winkel2 : wmax = winkel1
     AddLine arrPts(1), arrPts(3) 'Dreieckszerlegung bei kleinerem Winkel
  End If
  wmin = Fix(wmin*100)/100: wmax = Fix(wmax*100)/100
  MessageBox "*Viereck nicht planar*"&vbNewLine& _
                    " Minimalwinkel = "&wmin&"°"&vbNewLine& _
                    " Maximalwinkel = "&wmax&"°"
End Sub
Main 'Aufruf des Hauptprogramms

'=================================
'Funktionen aus der Vector-Library
'=================================
'Make a vector from two 3D points
Public Function VectorCreate(p1, p2)
  VectorCreate = Null
  If Not IsArray(p1) Or (UBound(p1) <> 2) Then Exit Function
  If Not IsArray(p2) Or (UBound(p2) <> 2) Then Exit Function
  VectorCreate =  Array(p2(0) - p1(0), p2(1) - p1(1), p2(2) - p1(2))
End Function

'Unitize a 3D vector
Public Function VectorUnitize(v)
  VectorUnitize = Null
  If Not IsArray(v) Or (UBound(v) <> 2) Then Exit Function
  Dim dist, x, y, z, x2, y2, z2
  x = v(0) : y = v(1) : z = v(2)
  x2 = x * x : y2 = y * y : z2 = z * z
  dist = x2 + y2 + z2
  If (dist < 0.0) Then Exit Function
  dist = Sqr(dist)
  x = x / dist
  y = y / dist
  z = z / dist
  VectorUnitize = Array(x, y, z)
End Function

'Return the dot product of two 3D vectors
Public Function VectorDotProduct(v1, v2)
  VectorDotProduct = Null
  If Not IsArray(v1) Or (UBound(v1) <> 2) Then Exit Function
  If Not IsArray(v2) Or (UBound(v2) <> 2) Then Exit Function
  VectorDotProduct = v1(0) * v2(0) + v1(1) * v2(1) + v1(2) * v2(2)
End Function

'Return the cross product of two 3D vectors
Public Function VectorCrossProduct(v1, v2)
  VectorCrossProduct = Null
  If Not IsArray(v1) Or (UBound(v1) <> 2) Then Exit Function
  If Not IsArray(v2) Or (UBound(v2) <> 2) Then Exit Function
  Dim x, y, z
  x = v1(1) * v2(2) - v1(2) * v2(1)
  y = v1(2) * v2(0) - v1(0) * v2(2)
  z = v1(0) * v2(1) - v1(1) * v2(0)
  VectorCrossProduct = Array(x, y, z)
End Function

'Function: Arccos
Function Arccos(x)
  Arccos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)
End Function

'Compare two 3D vectors for equality
Public Function VectorCompare(v1, v2)
  VectorCompare = False
  If Not IsArray(v1) Or (UBound(v1) <> 2) Then Exit Function
  If Not IsArray(v2) Or (UBound(v2) <> 2) Then Exit Function
  If v1(0) = v2(0) And v1(1) = v2(1) And v1(2) = v2(2) Then
    VectorCompare = True
  End If
End Function

 

Permalink Reply by Danny Boyes on May 3, 2011 at 10:29am

This is indeed RhinoScript which is based on VBScript which is not the same as VB.NET.

From what I can tell this ghx file might do the same thing.

If this is what you are after I could re-write to work with multiple four point sets

 

Attachments:

• PlanarSrfs_SplitTriangles.ghx, 373 KB