スクリプト関連/7

--- 面と面の距離.rvb ---
'On error resume Next

Dim sfa,sfb,ln,arrPta1,arrPta2,arr,pt,i
Dim dist,dist1,dist2,dist3,dist4,dist5
Dim pta,pta1,pta2,pta3,pta4,pta5
Dim ptb,ptb1,ptb2,ptb3,ptb4,ptb5

Main1

Function Main1
  Rhino.UnSelectAllObjects
  Do
    sfa=Rhino.GetObject ("面Ａを選択",8,False,True)
    If IsNull(sfa) Then
      Exit Function
    End if
    arr=Rhino.UnselectedObjects
    sfb=Rhino.GetObject ("面Ｂを選択",8,False)
    If IsSurface(sfb) Then
      Exit Do 
    End If
  Loop
  Rhino.UnSelectAllObjects
  Rhino.SelectObject sfa
  Rhino.Command "noecho _ExtractPt"
  If Rhino.LastCommandResult<>0 Then
    Exit Function
  End If
  arrPta1=Rhino.SelectedObjects
  Rhino.SelectObject sfa
  Rhino.Command "noecho _Pull "
  Rhino.DeleteObjects arrPta1
  If Rhino.LastCommandResult<>0 Then
    Exit Function
  End if
  arrPta2=Rhino.SelectedObjects
  i=0:dist=Null
  For Each pt in arrPta2
    If Rhino.IsPointOnSurface _
       (sfa,Rhino.PointCoordinates (pt)) Then
      i=i+1
      ptb=Rhino.BrepClosestPoint _
          (sfb, Rhino.PointCoordinates(pt))(0)
      dist1=Rhino.Distance _
          (Rhino.PointCoordinates(pt),ptb)
      If IsNull(dist) Then
        dist=dist1
      Else
        If dist1<dist Then 
          ptb1=ptb
          dist=dist1
        End If
      End If
    End If
  Next
  Rhino.DeleteObjects arrPta2
  pta2=Rhino.BrepClosestPoint(sfa, ptb1)(0)
  dist2=Rhino.Distance(ptb1,pta2)
  ptb2=Rhino.BrepClosestPoint(sfb, pta2)(0)
  dist3=Rhino.Distance(ptb2,pta2)
  pta3=Rhino.BrepClosestPoint(sfa, ptb2)(0)
  dist4=Rhino.Distance(ptb2,pta3)
  ptb3=Rhino.BrepClosestPoint(sfb, pta3)(0)
  dist5=Rhino.Distance(ptb3,pta3)
  'Rhino.AddPoint ptb3
  'MsgBox dist2 & vbcr & dist3 & vbcr & dist4 & vbcr & dist5
  ln=Rhino.AddLine (pta3,ptb3)
  Rhino.SelectObject ln
  Rhino.MessageBox dist5, 0 ,"距離"
End Function
--- 面と面の距離.rvb ここまで ---