Pick a point

<?xml encoding=”UTF-8″>By Adam Nagy

If you’d like to pick a point in the model then you can use the InteractionEvents.MouseEvents.OnMouseMove/OnMouseClick events. In these the ModelPosition parameter will give you a 3d point in the Target plane of the camera based on the mouse location. However, you may want to get back a point on the face under the cursor. In that case you could use the FindUsingRay/FindUsingVector functions.

I extended the sample code from Brian Ekins, which was for picking 2d points in a drawing, with the function that can transform the point from the Target plane onto the face. Since the Target plane could even be beyond the face that logically the point should be picked on, therefore first we’ll transform the ModelPosition to the Screen plane, and then use that along with the view direction vector inside the FindUsingRay function to get back the face and the intersection point.

Here is the class that provides the functionality:

Option Explicit
' Declare the event objects
Private WithEvents oInteractEvents As InteractionEvents
Private WithEvents oMouseEvents As MouseEvents
' Declare a flag that's used to determine when selection stops.
Private bStillSelecting As Boolean
Private modelPoint As Point
Public Function GetPoint() As Point
' Initialize flag.
bStillSelecting = True
' Create an InteractionEvents object.
Set oInteractEvents = _
ThisApplication.CommandManager.CreateInteractionEvents
' Ensure interaction is enabled.
oInteractEvents.InteractionDisabled = False
' Set a reference to the mouse events.
Set oMouseEvents = oInteractEvents.MouseEvents
oMouseEvents.MouseMoveEnabled = True
' Start the InteractionEvents object.
oInteractEvents.Start
' Loop until a (3D) point in the model is selected.
Do While bStillSelecting
DoEvents
Loop
' Stop the InteractionEvents object.
oInteractEvents.Stop
' Clean up.
Set oMouseEvents = Nothing
Set oInteractEvents = Nothing
Set GetPoint = modelPoint
End Function
Private Sub oInteractEvents_OnTerminate()
' Set the flag to indicate we're done.
bStillSelecting = False
End Sub
Private Function MovePtToFace(pt As Point, v As View) As Point
' Get the view direction, i.e. the vector pointing
' from the Eye to the Target
Dim e2t As Vector
Set e2t = v.Camera.eye.VectorTo(v.Camera.Target)
' The vector that will take the Model Point from the
' Target plane to the Screen plane is the opposite of e2t
Dim m2s As Vector
Set m2s = e2t.Copy
m2s.ScaleBy (-1)
Call pt.TranslateBy(m2s)
Dim doc As PartDocument
Set doc = v.Document
' Now we can shoot a ray from the Screen plane
' towards the model along the view direction to
' find the first object it hits and the intersection point
Dim objects As ObjectsEnumerator
Dim pts As ObjectsEnumerator
Call doc.ComponentDefinition.FindUsingRay( _
pt, e2t.AsUnitVector(), _
0.001, objects, pts)
If pts.Count > 0 Then
Set MovePtToFace = pts(1)
End If
End Function
Private Sub oMouseEvents_OnMouseClick( _
ByVal Button As MouseButtonEnum, _
ByVal ShiftKeys As ShiftStateEnum, _
ByVal ModelPosition As Point, _
ByVal ViewPosition As Point2d, _
ByVal View As View)
bStillSelecting = False
' ModelPosition will be on the Target Plane
' which is a plane parallel to the screen's plane
' but instead of including the Camera.Eye position
' this includes the Camera.Target position
Set modelPoint = MovePtToFace(ModelPosition, View)
End Sub
Private Sub oMouseEvents_OnMouseMove( _
ByVal Button As MouseButtonEnum, _
ByVal ShiftKeys As ShiftStateEnum, _
ByVal ModelPosition As Point, _
ByVal ViewPosition As Point2d, _
ByVal View As View)
Dim newPos As Point
Set newPos = MovePtToFace(ModelPosition, View)
If Not newPos Is Nothing Then Set ModelPosition = newPos
ThisApplication.StatusBarText = _
ModelPosition.x & " : " & _
ModelPosition.y & " : " & _
ModelPosition.z
End Sub

And here is the code that is using the above class:

Sub Get3dPoint()
Dim oSelectedPoint As New clsGetPoint
Dim modelPoint As Point
Set modelPoint = oSelectedPoint.GetPoint
If Not modelPoint Is Nothing Then
Dim doc As PartDocument
Set doc = ThisApplication.ActiveDocument
Call doc.ComponentDefinition.WorkPoints.AddFixed(modelPoint)
End If
End Sub

Here is a picture of the tests I’ve done with the code, which places work points at the picked positions