Circle From Normal

Option Explicit

Sub CircleFromNormal()
 Dim arrCenter, dblRadius
 Dim ptOn1, ptOn2, crvDomain
 Dim vecN, strCMD
 Dim idLast, idNew
 
 idLast = Rhino.FirstObject(vbFalse, vbTrue)
 If IsNull(idLast) Then idLast = "Nothing"
 Rhino.Command "-_Circle", vbFalse
 If Rhino.LastCommandResult <> 0 Then Exit Sub
 idNew = Rhino.FirstObject
 If idNew = idLast Then Exit Sub
 idLast = idNew
 If Not Rhino.IsCircle(idNew) Then Exit Sub

 arrCenter = Rhino.CircleCenterPoint(idNew)
 dblRadius = Rhino.CircleRadius(idNew)
 crvDomain = Rhino.CurveDomain(idNew)
 ptOn1 = Rhino.EvaluateCurve(idNew, crvDomain(0))
 ptOn2 = Rhino.EvaluateCurve(idNew, crvDomain(0) + (crvDomain(1)-crvDomain(0))/4)
 vecN = CrossVector(Array(ptOn1(0)-arrCenter(0), _
        ptOn1(1)-arrCenter(1), _
        ptOn1(2)-arrCenter(2)), _
        Array(ptOn2(0)-arrCenter(0), _
        ptOn2(1)-arrCenter(1), _
        ptOn2(2)-arrCenter(2)))
 vecN(0) = vecN(0) + arrCenter(0)
 vecN(1) = vecN(1) + arrCenter(1)
 vecN(2) = vecN(2) + arrCenter(2)

 Rhino.UnselectAllObjects
 Rhino.SelectObject idNew
 strCMD = "-_Orient _Copy=No _Scale=No" & _
   " w" & Rhino.Pt2Str(arrCenter) & _
   " w" & Rhino.Pt2Str(vecN) & _
   " w" & Rhino.Pt2Str(arrCenter)

 Rhino.Command strCMD, vbFalse
 If Rhino.LastCommandResult <> 0 Then
  Rhino.DeleteObject idNew
  Exit Sub
 End If
 
 strCMD = "-_Scale _Copy=No" & _
   " w" & Rhino.Pt2Str(arrCenter) & _
   " w" & Rhino.Pt2Str(ptOn1)
 Rhino.Command strCMD, vbFalse
End Sub
CircleFromNormal

Function CrossVector(vec1, vec2)
 Dim ptCross(2)
 ptCross(0) = ((vec1(1))*(vec2(2)) - (vec1(2))*(vec2(1)))
 ptCross(1) = ((vec1(2))*(vec2(0)) - (vec1(0))*(vec2(2)))
 ptCross(2) = ((vec1(0))*(vec2(1)) - (vec1(1))*(vec2(0)))
 CrossVector = ptCross
End Function

Ekleyen: Mad_Max