RhinoScriptSamples/ExtractUVIntersectPts.rvb at master · scotttd/RhinoScriptSamples · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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