Rogozinski Wladimir's Page

Script work more correct :)

Option Explicit

'Script written by Rogozinski Wladimir
'Script copyrighted Rogozinski Wladimir
'Script version 15 Desember 2014.

Call UniformSurfasePoints()

Sub UniformSurfasePoints()

Dim strObject,arrEdgeCurve,ListText(0),ListValue(0),ListResult,Rows,Colums,dblLength,arrPointsX,arrPointsY

Dim arrParameter,i,j,IsoCurveX(),IsoCurveY(),arrSurfPnt,arrPoint()

strObject = Rhino.GetObject("Select surface", 24)

Rhino.EnableRedraw(False)

If IsNull(strObject) Then Exit Sub

Rows = 10

ListText(0) = "Number points in surface short edge"

ListValue(0) = CStr(Rows)

ListResult = Rhino.PropertyListBox(ListText, ListValue, "Settings: ","Surfase Properties")

If Not IsArray(ListResult) Then Exit Sub

If IsNumeric(ListResult(0)) Then

Rows = CInt(ListResult(0))

Else

Rows = 10

End If

Rows = Rows - 1

arrEdgeCurve = Rhino.DuplicateEdgeCurves (strObject)

If Rhino.CurveLength(arrEdgeCurve(0)) = Rhino.CurveLength(arrEdgeCurve(1)) Then

dblLength = Rhino.CurveLength(arrEdgeCurve(0)) / Rows

End If

If Rhino.CurveLength(arrEdgeCurve(0)) > Rhino.CurveLength(arrEdgeCurve(1)) Then

dblLength = Rhino.CurveLength(arrEdgeCurve(1)) / Rows

Colums = Rhino.CurveLength(arrEdgeCurve(0)) / dblLength

End If

If Rhino.CurveLength(arrEdgeCurve(0)) < Rhino.CurveLength(arrEdgeCurve(1)) Then

dblLength = Rhino.CurveLength(arrEdgeCurve(0)) / Rows

Colums = Rhino.CurveLength(arrEdgeCurve(1)) / dblLength

End If

arrPointsX = Rhino.DivideCurveLength(arrEdgeCurve(0), dblLength)

arrPointsY = Rhino.DivideCurveLength(arrEdgeCurve(1), dblLength)

If Rhino.CurveLength(arrEdgeCurve(0)) > Rhino.CurveLength(arrEdgeCurve(1)) Then

For i=0 To Colums

arrParameter = Rhino.SurfaceClosestPoint(strObject, arrPointsX(i))

ReDim Preserve IsoCurveX(i)

IsoCurveX(i) = Rhino.ExtractIsoCurve (strObject, arrParameter , 1)

Next

End If

If Rhino.CurveLength(arrEdgeCurve(0)) < Rhino.CurveLength(arrEdgeCurve(1)) Then

For i=0 To Rows

arrParameter = Rhino.SurfaceClosestPoint(strObject, arrPointsX(i))

ReDim Preserve IsoCurveX(i)

IsoCurveX(i) = Rhino.ExtractIsoCurve (strObject, arrParameter , 1)

Next

End If

If Rhino.CurveLength(arrEdgeCurve(0)) > Rhino.CurveLength(arrEdgeCurve(1)) Then

For i=0 To Rows

arrParameter = Rhino.SurfaceClosestPoint(strObject, arrPointsY(i))

ReDim Preserve IsoCurveY(i)

IsoCurveY(i) = Rhino.ExtractIsoCurve (strObject, arrParameter , 0)

Next

End If

If Rhino.CurveLength(arrEdgeCurve(0)) < Rhino.CurveLength(arrEdgeCurve(1)) Then

For i=0 To Colums

arrParameter = Rhino.SurfaceClosestPoint(strObject, arrPointsY(i))

ReDim Preserve IsoCurveY(i)

IsoCurveY(i) = Rhino.ExtractIsoCurve (strObject, arrParameter , 0)

Next

End If

If Rhino.CurveLength(arrEdgeCurve(0)) > Rhino.CurveLength(arrEdgeCurve(1)) Then

ReDim arrPoint(Colums,Rows)

For i=0 To Colums

For j=0 To Rows

arrSurfPnt = Rhino.CurveCurveIntersection(IsoCurveX(i)(0), IsoCurveY(j)(0))

arrPoint(i,j) = arrSurfPnt(0,1)

Rhino.AddPoint arrPoint(i,j) 'oder insert structure by point coordinat

Next

Rhino.DeleteObject IsoCurveX(i)(0)

Next

For i=0 To Rows

Rhino.DeleteObjects IsoCurveY(i)

Next

End If

If Rhino.CurveLength(arrEdgeCurve(0)) < Rhino.CurveLength(arrEdgeCurve(1)) Then

ReDim arrPoint(Rows,Colums)

For i=0 To Rows

For j=0 To Colums

arrSurfPnt = Rhino.CurveCurveIntersection(IsoCurveX(i)(0), IsoCurveY(j)(0))

arrPoint(i,j) = arrSurfPnt(0,1)

Rhino.AddPoint arrPoint(i,j) 'oder insert structure by point coordinat

Next

Rhino.DeleteObject IsoCurveX(i)(0)

Next

For i=0 To Colums

Rhino.DeleteObjects IsoCurveY(i)

Next

End If

Rhino.DeleteObjects arrEdgeCurve

Rhino.EnableRedraw(True)

End Sub