Add more stuff to repository.

CheckForWizards.rvb

@@ -0,0 +1,87 @@
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+' CheckForWizards.rvb -- October 2008
+' If this code works, it was written by Dale Fugier.
+' If not, I don't know who wrote it.
+' Works with Rhino 4.0.
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+
+Option Explicit
+
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+' Obviously too much free time...
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+Sub CheckForWizards
+
+  Dim strObject, strView, arrBox, arrPoint
+  Dim arrCorners, arrOrigin
+  Dim strAgentName, strAgentPath
+  Dim objAgent, objCharacter
+
+  strObject = Rhino.GetObject("Select object to check", 0, True, True)
+  If IsNull(strObject) Then Exit Sub
+
+  strView = Rhino.CurrentView
+  arrBox = Rhino.BoundingBox(strObject)    
+  arrPoint = Rhino.XFormWorldToScreen(arrBox(2), strView, True)
+  arrCorners = Rhino.ViewNearCorners
+  arrOrigin = Rhino.XFormWorldToScreen(arrCorners(3), strView, True)
+
+  strAgentName = "Merlin"
+  strAgentPath = "c:\windows\msagent\chars\" & strAgentName & ".acs"
+  Set objAgent = CreateObject("Agent.Control.2")
+  If Not IsObject(objAgent) Then Exit Sub
+
+  objAgent.Connected = True
+  objAgent.Characters.Load strAgentName, strAgentPath
+  Set objCharacter = objAgent.Characters.Character(strAgentName)
+
+  objCharacter.MoveTo arrOrigin(0),arrOrigin(1)
+  objCharacter.Show
+  objCharacter.Play "GetAttention"
+  objCharacter.Play "Announce"
+  objCharacter.Speak "Hello, I am the fabulous Rhino geometry checking wizard."
+  objCharacter.Play "LookDown"
+  objCharacter.Speak "I am here to see if your geometry is of questionable quality..."
+  objCharacter.Play "Explain"
+  objCharacter.Speak "..um...geometrically speaking, of course."
+  objCharacter.MoveTo arrPoint(0),arrPoint(1)
+  objCharacter.Play "Uncertain"
+  objCharacter.Play "LookRight"
+  objCharacter.Play "Confused"
+  objCharacter.Think "Hmm....very interesting...not sure I have seen one of these before."
+  objCharacter.Play "Explain"
+  objCharacter.Speak "It looks like Euclidean geometry consisting of points in a plane which are at a constant distance from a fixed point."
+  objCharacter.Play "Alert"
+  objCharacter.Speak "Hey, I don't have a Ph.D in computational geometry, but I did stay at a Holiday Inn Express last night."
+  objCharacter.Play "Pleased"
+  objCharacter.Play "GestureRight"
+  objCharacter.Speak "Let me check this geometry for you."
+  objCharacter.Play "Read"
+  objCharacter.Play "ReadContinued"
+  objCharacter.Speak "...hmm..."
+  objCharacter.Play "ReadReturn"
+  objCharacter.Play "Process"
+  objCharacter.Play "Think"
+  objCharacter.Speak "...I see..."
+  objCharacter.Play "Search"
+  objCharacter.Speak "Well, what do you know."
+  objCharacter.Play "Sad"
+  objCharacter.Speak "Your geometry sucks!"
+  objCharacter.Play "Decline"
+  objCharacter.Speak "I cannot take responsiblity for this, of course."
+  objCharacter.Play "Suggest"
+  objCharacter.Speak "You might try reinstalling all of your software and try it again."
+  objCharacter.Play "RestPose"
+  objCharacter.Play "Surprised"
+  objCharacter.Speak "Sorry, I have to go. I see more geometry that sucks."
+  objCharacter.MoveTo arrOrigin(0),arrOrigin(1)
+  objCharacter.Play "Wave"
+  objCharacter.Play "DoMagic1"
+  objCharacter.Play "DoMagic2"
+  objCharacter.Hide
+
+  Do While objCharacter.Visible = True
+      Rhino.Sleep 100
+  Loop
+
+End Sub

Dodecahedron.rvb

@@ -0,0 +1,90 @@
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+' Dodecahedron.rvb -- March 2012
+' If this code works, it was written by Dale Fugier.
+' If not, I don't know who wrote it.
+' Works with Rhino 4.0.
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+
+Option Explicit
+
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+' Create a regular Dodecahedron composed of 12 regular pentagons.
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+Sub Dodecahedron()
+
+  ' Declare local variables
+  Dim center, phi, a, b
+  Dim v(19), p(11), s(11)
+
+  ' Prompt for center point
+  center = Rhino.GetPoint("Center of dodecahedron")
+  If IsNull(center) Then Exit Sub
+
+  ' This will make the script run faster  
+  Call Rhino.EnableRedraw(False)
+
+  ' A few calculations...
+  phi = (1.0 + Sqr(5.0)) * 0.5
+  a = 1 / phi
+  b = 1 / (phi * phi)
+
+  ' Define the dodecahedron's 20 vertices
+  v(0)  = Rhino.PointAdd(center, Array( 0,  1,  b))
+  v(1)  = Rhino.PointAdd(center, Array( 0,  1, -b))
+  v(2)  = Rhino.PointAdd(center, Array( 0, -1,  b))
+  v(3)  = Rhino.PointAdd(center, Array( 0, -1, -b))
+  v(4)  = Rhino.PointAdd(center, Array( 1,  b,  0))
+  v(5)  = Rhino.PointAdd(center, Array(-1,  b,  0))
+  v(6)  = Rhino.PointAdd(center, Array( 1, -b,  0))
+  v(7)  = Rhino.PointAdd(center, Array(-1, -b,  0))
+  v(8)  = Rhino.PointAdd(center, Array( a,  a,  a))
+  v(9)  = Rhino.PointAdd(center, Array(-a,  a,  a))
+  v(10) = Rhino.PointAdd(center, Array( a,  a, -a))
+  v(11) = Rhino.PointAdd(center, Array(-a,  a, -a))
+  v(12) = Rhino.PointAdd(center, Array( a, -a,  a))
+  v(13) = Rhino.PointAdd(center, Array(-a, -a,  a))
+  v(14) = Rhino.PointAdd(center, Array( a, -a, -a))
+  v(15) = Rhino.PointAdd(center, Array(-a, -a, -a)) 
+  v(16) = Rhino.PointAdd(center, Array( b,  0,  1))
+  v(17) = Rhino.PointAdd(center, Array(-b,  0,  1))
+  v(18) = Rhino.PointAdd(center, Array( b,  0, -1))
+  v(19) = Rhino.PointAdd(center, Array(-b,  0, -1))
+
+  ' Create the dodecahedron's 12 faces
+  p(0)  = Rhino.AddPolyline(Array(v(16), v(17), v( 9), v( 0), v( 8), v(16)))
+  p(1)  = Rhino.AddPolyline(Array(v(17), v(16), v(12), v( 2), v(13), v(17)))
+  p(2)  = Rhino.AddPolyline(Array(v(18), v(19), v(15), v( 3), v(14), v(18)))
+  p(3)  = Rhino.AddPolyline(Array(v(19), v(18), v(10), v( 1), v(11), v(19)))
+  p(4)  = Rhino.AddPolyline(Array(v( 1), v( 0), v( 8), v( 4), v(10), v( 1)))
+  p(5)  = Rhino.AddPolyline(Array(v( 0), v( 1), v(11), v( 5), v( 9), v( 0)))
+  p(6)  = Rhino.AddPolyline(Array(v( 3), v( 2), v(13), v( 7), v(15), v( 3)))
+  p(7)  = Rhino.AddPolyline(Array(v( 2), v( 3), v(14), v( 6), v(12), v( 2)))
+  p(8)  = Rhino.AddPolyline(Array(v( 4), v( 6), v(12), v(16), v( 8), v( 4)))
+  p(9)  = Rhino.AddPolyline(Array(v( 6), v( 4), v(10), v(18), v(14), v( 6)))
+  p(10) = Rhino.AddPolyline(Array(v( 5), v( 7), v(15), v(19), v(11), v( 5)))
+  p(11) = Rhino.AddPolyline(Array(v( 7), v( 5), v( 9), v(17), v(13), v( 7)))
+
+  s(0)  = Rhino.AddPlanarSrf(Array(p(0)))(0)
+  s(1)  = Rhino.AddPlanarSrf(Array(p(1)))(0)
+  s(2)  = Rhino.AddPlanarSrf(Array(p(2)))(0)
+  s(3)  = Rhino.AddPlanarSrf(Array(p(3)))(0)
+  s(4)  = Rhino.AddPlanarSrf(Array(p(4)))(0)
+  s(5)  = Rhino.AddPlanarSrf(Array(p(5)))(0)
+  s(6)  = Rhino.AddPlanarSrf(Array(p(6)))(0)
+  s(7)  = Rhino.AddPlanarSrf(Array(p(7)))(0)
+  s(8)  = Rhino.AddPlanarSrf(Array(p(8)))(0)
+  s(9)  = Rhino.AddPlanarSrf(Array(p(9)))(0)
+  s(10) = Rhino.AddPlanarSrf(Array(p(10)))(0)
+  s(11) = Rhino.AddPlanarSrf(Array(p(11)))(0)
+
+  ' Join all of the faces
+  Rhino.UnselectAllObjects()
+  Call Rhino.SelectObjects(s)
+  Call Rhino.Command("_Join", False)
+  Call Rhino.DeleteObjects(p)
+  Rhino.UnselectAllObjects()
+
+  ' Don't forget to do this
+  Call Rhino.EnableRedraw(True)
+
+End Sub

Easter.rvb

@@ -0,0 +1,30 @@
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+' Easter.rvb -- October 2010
+' If this code works, it was written by Dale Fugier.
+' If not, I don't know who wrote it.
+' Works with Rhino 4.0.
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+
+Option Explicit
+
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+' Hey, when is the Easter holiday?
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+Sub Easter
+  Dim c, n, k, i, j, l, m, d, y, months
+  months = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
+  y = Year(Now)
+  c = y\100
+  n = y-19 * (y\19 )
+  k = (c-17)\25
+  i = c - c\4 - (c-k)\3 + 19 * n + 15
+  i = i - 30 * (i\30)
+  i = i - (i\28 ) * (1 - (i\28) * (29\(i+1)) * ((21-n)\11))
+  j = y + y\4 + i + 2 - c + c\4
+  j = j - 7 * (j\7 )
+  l = i - j
+  m = 3 + (l + 40)\44
+  d = l + 28 - 31 * (m\4)
+  Call MsgBox(months(m-1) & " " & CStr(d) & ", " & CStr(y), vbOKOnly + vbInformation, "Easter")
+End Sub
+

ExportBlockCount.rvb

@@ -0,0 +1,72 @@
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+' ExportBlockCount.rvb -- June 2010
+' If this code works, it was written by Dale Fugier.
+' If not, I don't know who wrote it.
+' Works with Rhino 4.0.
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+
+Option Explicit
+
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+' Exports a count of blocks to Excel
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+Sub ExportBlockCount()
+
+  Dim arrBlocks, strBlock, strName
+  Dim objCounts, objKey
+  Dim objExcel, objBook, objSheet, nCell
+
+  ' Get all of the block instances in the document
+  arrBlocks = Rhino.ObjectsByType(4096)
+  If IsNull(arrBlocks) Then
+    Call Rhino.Print("No blocks to export.")
+    Exit Sub
+  End If
+
+  ' Create a dictionary object for counting blocks
+  Set objCounts = CreateObject("Scripting.Dictionary")
+
+  ' Count the blocks
+  For Each strBlock In arrBlocks
+    strName = Rhino.BlockInstanceName(strBlock)
+    If objCounts.Exists(strName) Then
+      objCounts(strName) = objCounts(strName) + 1
+    Else
+      Call objCounts.Add(strName, 1)
+    End If
+  Next
+
+  ' Create a Excel object
+  On Error Resume Next
+  Set objExcel = CreateObject("Excel.Application")
+  If Err = 0 Then
+
+    objExcel.Visible = True
+
+    ' Initialize Excel
+    Set objBook = objExcel.Workbooks.Add
+    Set objSheet = objBook.Worksheets(1)
+
+    ' Place titles on sheet
+    nCell = 1
+    objExcel.Cells(nCell, 1).Value = "Block Name"
+    objExcel.Cells(nCell, 2).Value = "Count"
+    objExcel.Cells(nCell, 3).Value = "Description"
+    nCell = nCell + 1
+
+    ' Write the blocks and counts to the sheet
+    For Each objKey In objCounts
+      objExcel.Cells(nCell, 1).Value = CStr(objKey)
+      objExcel.Cells(nCell, 2).Value = CStr(objCounts(objKey))
+      objExcel.Cells(nCell, 3).Value = Rhino.BlockDescription(objKey)
+     nCell = nCell + 1
+    Next
+  End If    
+
+  ' Print to command line too
+  Call Rhino.Print("Block counts:")
+  For Each objKey In objCounts
+    Call Rhino.Print("  " & CStr(objKey) & " = " & CStr(objCounts(objKey)))
+  Next
+
+End Sub