Dbl点击反应器

Private Sub AcadDocument_BeginDoubleClick(ByVal PickPoint As Variant)
 Dim AcadObj As AcadEntity
 Dim AcadDim As AcadDimension
 Dim SelSet As AcadSelectionSet
 
'translate our point so we can double click even in other UCS settings
 PickPoint = ThisDrawing.Utility.TranslateCoordinates(PickPoint, acWorld, acUCS, False)
 
 On Error GoTo ClearOut
'create selection set
 Set SelSet = ThisDrawing.SelectionSets.Add("ClickReactor")
'grab objects at point
 SelSet.SelectAtPoint PickPoint
'process each object ignoring those without a handler
 For Each AcadObj In SelSet
'Add conditional statement for all objects to handle along with the default handler
'edit text in default text editor
  If AcadObj.ObjectName = "AcDbText" Then
   SendCommand "_.ddedit" & vbLf & "(handent " & Chr(34) & AcadObj.Handle & Chr(34) & ")" & vbLf
'edit mtext in default text editor
  ElseIf AcadObj.ObjectName = "AcDbMText" Then
   SendCommand "_.ddedit" & vbLf & "(handent " & Chr(34) & AcadObj.Handle & Chr(34) & ")" & vbLf
  ElseIf AcadObj.ObjectName = "AcDbBlockReference" Then
'edit attributes in custom attribute editor
   If AcadObj.HasAttributes = True Then
    SendCommand "modatt" & vbLf '& "(handent " & Chr(34) & AcadObj.Handle & Chr(34) & ")" & vbLf
   End If
  End If
 Next AcadObj
' Funny thing about dims, they don't handle the same for some reason
 For Each AcadDim In SelSet
' step through all objects, even if they are not dims ... I am just lazy and don't want to filter for them
 On Error Resume Next
   SendCommand "_.ddedit" & vbLf & "(handent " & Chr(34) & AcadDim.Handle & Chr(34) & ")" & vbLf
 Next AcadDim
' We are done now do clean up 
ClearOut:
' delete the selection set
ThisDrawing.SelectionSets.Item("ClickReactor").Delete
' done now
End Sub