Visio dragDrop shape position not updated

Question

In this guide https://msdn.microsoft.com/en-us/library/office/ff767482.aspx , I am able to get a event trigger when I drag and drop my shapes. But the problem is the shape position is not updated to the drop position when I received this event trigger. My question is how do I get a updated position of the shape after I drop the it to perform some overlap check on the shape with other shapes in Visio?

Dim strMessage As String

'Find out which event and event extension fired
Select Case nEventCode
    Case visEvtCodeMouseMove
        Dim strInfo As String
        If (pSubjectObj.DragState = visMouseMoveDragStatesDrop) Then
            strMessage = "MouseMove - dragDrop"

            'Shape position is not updated to drop position here

        End If
    Case Else
        strMessage = "Other (" & nEventCode & ")"
End Select

 'Display the event name and the event code
If (Len(strMessage)) Then
    Debug.Print strMessage
End If

End Function

JohnGoldsmith JohnGoldsmith · Accepted Answer · 2016-09-16T11:36:19

In your first If statement, the subject object should be a MouseEvent object which has x and y properties (note in inches). You can then use those to search for any shapes that the target shape has been dropped on:

Dim evtMouse As Visio.MouseEvent
Dim selSearchShapes As Visio.Selection
...
Set evtMouse = pSubjectObj

Set selSearchShapes = evtMouse.Application.ActivePage.SpatialSearch(evtMouse.x, _
  evtMouse.y, _
  Visio.VisSpatialRelationCodes.visSpatialContainedIn, _
  0, _
  Visio.VisSpatialRelationFlags.visSpatialFrontToBack)

Debug.Print "Spatial search found: " & selSearchShapes.Count

If selSearchShapes.Count > 0 Then
  Debug.Print "Spatial search - top shape: " & selSearchShapes(1).NameID
End If

Visio dragDrop shape position not updated

1 Answers