Hi list,
I try to find a way to select a point on a surface, without a “select surface” operation.
This code works fine in parallel projection, but it doesn’t work in perspective view because of the view direction:
While True
go.SetCommandPrompt("Select points on faces. Shift to accumulate")
Dim get_rc As Rhino.Input.GetResult = go.Get()
If go.CommandResult() <> Rhino.Commands.Result.Success Then
Return go.CommandResult()
End If
If get_rc = Rhino.Input.GetResult.Object Then
Obref = go.Object(0)
Dim bSrf As Brep = Obref.Brep()
Dim view As Rhino.Display.RhinoView = go.View()
If view Is Nothing Then
view = doc.Views.ActiveView
If view Is Nothing Then
Return Rhino.Commands.Result.Failure
End If
End If
Dim windowsDrawingPoint As System.Drawing.Point
If Not GetCursorPos(windowsDrawingPoint) OrElse Not ScreenToClient(view.Handle, windowsDrawingPoint) Then
Return Result.Failure
End If
Dim xform = view.ActiveViewport.GetTransform(CoordinateSystem.Screen, CoordinateSystem.World)
Dim ClickPt = New Rhino.Geometry.Point3d(windowsDrawingPoint.X, windowsDrawingPoint.Y, 0.0)
ClickPt.Transform(xform)
Dim ckickVector As Vector3d = view.ActiveViewport.CameraDirection 'CameraTarget - view.ActiveViewport.CameraLocation
'ckickVector.Unitize()
Dim l As New Line(ClickPt, ckickVector * 100000)
doc.Objects.AddLine(l)
Dim RetCurves() As Curve = Nothing
Dim RetPts() As Point3d = Nothing
Dim events = Rhino.Geometry.Intersect.Intersection.CurveBrep(l.ToNurbsCurve, Obref.Brep, 0.001, RetCurves, RetPts)
Dim FacePt As Point3d = Nothing
If RetPts.Length > 0 Then
FacePt = RetPts(0)
If RetPts.Length > 1 Then
If RetPts(0).DistanceTo(view.ActiveViewport.CameraLocation) > RetPts(1).DistanceTo(view.ActiveViewport.CameraLocation) Then
FacePt = RetPts(1)
End If
End If
Please advise.
Kind regards,
Peter