Site Tools


Extracting Isocurve Intersection Points

Developer: RhinoScript
Summary: Demonstrates how to get the intersection points of a surface's isocurves.

Question

I would like to extract all the isocurves from a surface, just like the ExtractWireframe command does. But, I do not see a RhinoScript function that will do this. Is this possible? Once I have the curves, I want to intersect all of them to get the 3-D intersection points of all the curves.

extractuvintersectpts.jpg

Answer

Consider the following script.

 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 ' ExtractUVIntersectPts.rvb -- November 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
 
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 'Extracts surface wireframe curves
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Function RhExtractWireframe(sSurface)
 
   Dim aResults
   RhExtractWireframe = Null
 
   Call Rhino.SelectObject(sSurface)
 
   Call Rhino.Command("_-ExtractWireframe", 0)
   aResults = Rhino.LastCreatedObjects
   If IsArray(aResults) Then
     RhExtractWireframe = aResults
     Rhino.UnselectObjects(aResults)
   End If
 
   Call Rhino.UnselectObject(sSurface)
 
 End Function
 
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 'Intersects curves
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Function RhIntersect(aCurves)  
 
   Dim aResults, aPoints(), i
   RhIntersect = Null
 
   Call Rhino.SelectObjects(aCurves)  
 
   Call Rhino.Command("_-Intersect", 0)
   aResults = Rhino.LastCreatedObjects
   If IsArray(aResults) Then
     ReDim aPoints(UBound(aResults))
     For i = 0 To UBound(aResults)
       aPoints(i) = Rhino.PointCoordinates(aResults(i))
     Next
     Call Rhino.DeleteObjects(aResults)
     RhIntersect = aPoints
   End If
 
   Call Rhino.UnselectObjects(aCurves)
 
 End Function  
 
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 ' The one and only ExtractUVIntersectPts subroutine    
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Sub ExtractUVIntersectPts
 
   Dim sSurface, aCurves, aPoints, aObjects
 
   sSurface = Rhino.GetObject("Select surface", 24, True)
   If IsNull(sSurface) Then Exit Sub
 
   Call Rhino.EnableRedraw(False)
   aCurves = RhExtractWireframe(sSurface)
   If IsArray(aCurves) Then
     aPoints = RhIntersect(aCurves)
     Call Rhino.DeleteObjects(aCurves)
     If IsArray(aPoints) Then
       aObjects = Rhino.AddPoints(Rhino.CullDuplicatePoints(aPoints))
       Call Rhino.SelectObjects(aObjects)
     End If
   End If
   Call Rhino.EnableRedraw(True)
 
 End Sub
 
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Rhino.AddStartupScript Rhino.LastLoadedScriptFile
 Rhino.AddAlias "ExtractUVIntersectPts", "_NoEcho _-RunScript (ExtractUVIntersectPts)"
developer/scriptsamples/extractuvintersectpts.txt ยท Last modified: 2015/11/24 by sandy