Option Explicit 
Sub Poly2CrvMid () 
 
  Dim arrCrvs,strCrv, arrPoints,arrPoint 
  Dim K,i,arrNPt,hh,kk 
 
  arrCrvs = Rhino.GetObjects("Select curves", 4) 
 
  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 ,3) 
   hh=hh+1 
 
 
   End If 
  End If 
Next 
 
Rhino.SelectObjects arrCC 
 
End Sub 
 
Poly2CrvMid |