š» Rhino 5
š¼ Rhino Script
š ļø Visual Basic
Ā
Note: This is a very old and not very efficient script, you should always try _SelDup first.
In using laser cut files directly out of Rhino, I consistently found the need for a command similar to āoverkillā in Autocad for Rhino. In addition, those pesky overlapping surfaces which create render artifacts and kill render time just needed a quick fix. Though it is only able to detect points, curves, or surfaces, future adaptations for polysurfaces and possibly meshes are in the works. However, for what it does this Rhino Script has been helpful.
Ā
Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Sunday, November 02, 2008 1:18:47 PM
Call Main()
Sub Main()
Dim objects, segment
objects = Rhino.GetObjects("Select Points, Curves, and Surfaces",,, True)
If isNull(objects) Then Exit Sub
segment = Rhino.GetBoolean("DeleteSegments", array("CurveSegments", "No", "Yes"), array(True))
If isNull(segment) Then Exit Sub
Call Rhino.EnableRedraw(False)
Dim i,r,s,t, pts(), crvs(), srfs(), crvOutput
ReDim pts(0), crvs(0), srfs(0)
r = 0:s = 0:t = 0
For i = 0 To uBound(objects) Step 1
If Rhino.IsPoint(objects(i)) = True Then
ReDim Preserve pts(r)
pts(r) = objects(i)
r = r + 1
ElseIf Rhino.IsCurve(objects(i)) = True Then
ReDim Preserve crvs(s)
crvs(s) = objects(i)
s = s + 1
ElseIf Rhino.IsSurface(objects(i)) = True Then
ReDim Preserve srfs(t)
srfs(t) = objects(i)
t = t + 1
End If
Next
If uBound(pts) > 0 Then
Call overKillPoints(pts)
End If
If uBound(crvs) > 0 Then
crvOutput = overKillCurves(crvs)
If segment(0) = True Then
Call partialOverlap(crvOutput)
End If
End If
If uBound(srfs) > 0 Then
Call overKillSurfaces(srfs)
End If
Call Rhino.EnableRedraw(True)
End Sub
Function overKillPoints(points)
overKillPoints = Null
Dim i,j,count, pts(), deleted()
count = uBound(points)
ReDim pts(count), deleted(count)
For i = 0 To count Step 1
pts(i) = Rhino.PointCoordinates(points(i))
deleted(i) = False
Next
For i = 0 To count Step 1
For j = 0 To count Step 1
If j <> i Then
If deleted(j) = False Then
If pts(i)(0) = pts(j)(0) And pts(i)(1) = pts(j)(1) And pts(i)(2) = pts(j)(2) Then
Call Rhino.DeleteObject(points(i))
deleted(i) = True
End If
End If
End If
Next
Next
End Function
Function overKillCurves(curves)
overKillCurves = Null
Dim i,j,k,m,r,count, pts(), blnVal, deleted()
count = uBound(curves)
ReDim pts(count), deleted(count)
For i = 0 To count Step 1
pts(i) = Rhino.CurvePoints(curves(i))
deleted(i) = False
Next
blnVal = 0
For i = 0 To count Step 1
For j = 0 To count Step 1
If j <> i Then
If deleted(j) = False Then
If Ubound(pts(i)) = uBound(pts(j)) Then
For k = 0 To Ubound(pts(i)) Step 1
m = Ubound(pts(i)) - k
If pts(i)(k)(0) = pts(j)(k)(0) And pts(i)(k)(1) = pts(j)(k)(1) And pts(i)(k)(2) = pts(j)(k)(2) Or pts(i)(k)(0) = pts(j)(m)(0) And pts(i)(k)(1) = pts(j)(m)(1) And pts(i)(k)(2) = pts(j)(m)(2) Then
blnVal = blnVal + 1
End If
Next
If blnVal = uBound(pts(i)) + 1 Then
deleted(i) = True
End If
blnVal = 0
End If
End If
End If
Next
Next
r = 0
Dim crvOutput()
For i = 0 To count Step 1
If deleted(i) = True Then
Call Rhino.DeleteObject(curves(i))
Else
ReDim Preserve crvOutput(r)
crvOutput(r) = curves(i)
r = r + 1
End If
Next
overKillCurves = crvOutput
End Function
Function overKillSurfaces(surfaces)
overKillSurfaces = Null
Dim i,j,k,m,n,r,s,t,count, tCount, uvCnt
Dim aPt(), bPt(), cPt(), dPt(), ePt(), fPt(), gPt(), hPt()
Dim ptsA(), pts(), tPts(), sPts(), blnVal, deleted()
count = uBound(surfaces)
ReDim ptsA(count), pts(count), deleted(count)
For i = 0 To count Step 1
r = 0: s = 0
ptsA(i) = Rhino.SurfacePoints(surfaces(i))
uvCnt = Rhino.SurfacePointCount(surfaces(i))
tCount = Ubound(ptsA(i))
ReDim tPts(uvCnt(0)-1), sPts(uvCnt(1)-1)
For j = 0 To tCount Step 1
tPts(r) = ptsA(i)(tCount - j)
r = r + 1
If r = uvCnt(0) Then
r = 0
sPts(s) = tPts
s = s + 1
End If
Next
ReDim aPt(tCount), bPt(tCount), cPt(tCount), dPt(tCount), ePt(tCount), fPt(tCount), gPt(tCount), hPt(tCount)
t = 0
For j = 0 To uvCnt(0) - 1 Step 1
For k = 0 To uvCnt(1) - 1 Step 1
aPt(t) = sPts(j)(k)
bPt(t) = sPts(uvCnt(0) - 1 - j)(uvCnt(1) - 1 - k)
cPt(t) = sPts(j)(uvCnt(1) - 1 - k)
dPt(t) = sPts(uvCnt(0) - 1 - j)(k)
t = t + 1
Next
Next
t = 0
For j = 0 To uvCnt(1) - 1 Step 1
For k = 0 To uvCnt(0) - 1 Step 1
ePt(t) = sPts(k)(j)
fPt(t) = sPts(uvCnt(0) - 1 - k)(uvCnt(1) - 1 - j)
gPt(t) = sPts(k)(uvCnt(1) - 1 - j)
hPt(t) = sPts(uvCnt(0) - 1 - k)(j)
t = t + 1
Next
Next
pts(i) = array(apt, bpt, cpt, dpt, ept, fpt, gpt, hpt)
deleted(i) = False
Next
blnVal = 0
For i = 0 To count Step 1
For j = 0 To count Step 1
If j <> i Then
If deleted(j) = False Then
If Ubound(pts(i)(0)) = uBound(pts(j)(0)) Then
For m = 0 To 7 Step 1
For n = 0 To 7 Step 1
For k = 0 To Ubound(pts(i)(0)) Step 1
If pts(i)(m)(k)(0) = pts(j)(n)(k)(0) And pts(i)(m)(k)(1) = pts(j)(n)(k)(1) And pts(i)(m)(k)(2) = pts(j)(n)(k)(2) Then
blnVal = blnVal + 1
End If
Next
Next
Next
If blnVal >= uBound(pts(j)(0)) Then
Call Rhino.DeleteObject(surfaces(i))
deleted(i) = True
End If
blnVal = 0
End If
End If
End If
Next
Next
End Function
Function partialOverlap(crvs)
partialOverlap = Null
Dim i, j, k, count, blnDelete(), dblOverlap
count = uBound(crvs)
dblOverlap = 0
Dim crvPts()
ReDim crvPts(count), blnDelete(count)
For i = 0 To count Step 1
crvPts(i) = Rhino.CurveEditPoints(crvs(i))
blnDelete(i) = False
Next
For i = 0 To count Step 1
For j = 0 To count Step 1
If i <> j Then
For k = 0 To uBound(crvPts(j)) Step 1
If Rhino.IsPointOnCurve(crvs(i), crvPts(j)(k)) = True Then
dblOverlap = dblOverlap + 1
End If
Next
End If
If uBound(crvPts(j)) + 1 = dblOverlap Then
blnDelete(j) = True
End If
dblOverlap = 0
Next
Next
For i = 0 To count Step 1
If blnDelete(i) = True Then
Call Rhino.DeleteObject(crvs(i))
End If
Next
partialOverlap = array()
End FunctionĀ
