Rhino Script

Mid Points Box

Option Explicit

Sub BoxFromEdgeMidPoints()
    Dim selObjects
    Dim recMan, arrC(4), newC, newM
    Dim curLast, newLast

    curLast = Rhino.FirstObject
    selObjects = Rhino.SelectedObjects
    If Not IsArray(selObjects) Then selObjects = Array("Nothing")

    arrC(0) = Array(10000,10000,10000)
    arrC(1) = Array(10002,10000,10000)
    arrC(2) = Array(10002,10002,10000)
    arrC(3) = Array(10000,10002,10000)
    arrC(4) = Array(10000,10000,10000)
    recMan = Rhino.AddPolyline(arrC)

    Rhino.UnselectAllObjects
    Rhino.SelectObject recMan
    Rhino.Command "-_NoEcho", vbFalse
    Rhino.Command "-_Orient _Copy=No _Scale=Yes w" & Rhino.Pt2Str(Array(10000,10001,10000)) & _
                                              " w" & Rhino.Pt2Str(Array(10002,10001,10000)), vbFalse
    If Rhino.LastCommandResult <> 0 Then
        Rhino.DeleteObject recMan
        Rhino.SelectObjects selObjects
        Exit Sub
    End If

    newLast = Rhino.FirstObject
    If newLast <> recMan Then
        Rhino.DeleteObject recMan
        Rhino.SelectObjects selObjects
        Exit Sub
    End If

    newC = Rhino.PolylineVertices(recMan)
    If Not IsArray(newC) Then
        Rhino.DeleteObject recMan
        Rhino.SelectObjects selObjects
        Exit Sub
    Else
        If UBound(newC) <> 4 Then
            Rhino.DeleteObject recMan
            Rhino.SelectObjects selObjects
            Exit Sub
        End If
    End If

    If Rhino.Distance(arrC(0),newC(0)) + _
       Rhino.Distance(arrC(1),newC(1)) + _
       Rhino.Distance(arrC(2),newC(2)) + _
       Rhino.Distance(arrC(3),newC(3)) + _
       Rhino.Distance(arrC(4),newC(4)) < Rhino.UnitAbsoluteTolerance Then
        Rhino.DeleteObject recMan
        Rhino.SelectObjects selObjects
        Exit Sub
    End If

    newM = Array((newC(0)(0)+newC(3)(0))/2, _
                (newC(0)(1)+newC(3)(1))/2, _
                (newC(0)(2)+newC(3)(2))/2)

    Rhino.Command "-_Scale1D _Copy=No w" & Rhino.Pt2Str(newM) & " w" & Rhino.Pt2Str(newC(3)), vbFalse
    Rhino.Command "-_Extrude _BothSides=Yes _Cap=Yes _Mode=Straight _DeleteInput=Yes", vbFalse
    Rhino.SelectObjects selObjects
End Sub
BoxFromEdgeMidPoints

Ekleyen: Mad_Max