Suavizar políneas

Este es el Script para suavizar polilíneas:

Option Explicit
‘Script para suavizar polilíneas y hacer un offset de las mismas
Call SuavizarPolilineas()
Sub SuavizarPolilineas()
Dim arrCrvs,strCrv, arrPoints,arrPoint
Dim K,i,arrNPt,hh,kk, Offset, Degree
arrCrvs = Rhino.GetObjects(“Select curves”, 4)
Offset = Rhino.GetReal(“Offset?”)
Degree = Rhino.GetReal(“Degree?”,3,1,100)
If IsNull(arrCrvs) Then Exit Sub
ReDim arrCC(UBound(arrCrvs))
hh=0
For Each strCrv In arrCrvs
If Rhino.IsPolyline(strCrv) Then
arrPoints = Rhino.PolylineVertices(strCrv)
If IsArray(arrPoints) Then
k=UBound(arrPoints)
kk=(k+1)*2-2
ReDim arrNPt(kk)
Dim nn : nn=0
For i=1 To kk Step 2
arrNPt(i) = Array((arrPoints(nn)(0)+arrPoints(nn+1)(0))/2, (arrPoints(nn)(1)+arrPoints(nn+1)(1))/2, (arrPoints(nn)(2)+arrPoints(nn+1)(2))/2 )
nn=nn+1
Next
nn=0
For i=0 To kk Step 2
arrNPt(i) = arrPoints(nn)
nn=nn+1
Next
arrCC(hh) = Rhino.AddCurve (arrNPt ,Degree)
Dim arrCentro : arrCentro = Rhino.CurveAreaCentroid(arrCC(hh))
Call Rhino.OffsetCurve(arrCC(hh), arrCentro(0), Offset)
hh=hh+1
End If
End If
Next

Rhino.SelectObjects arrCC

Rhino.DeleteObjects arrCC

Rhino.DeleteObjects arrCrvs

End Sub

Comments are closed.