这是基本的外壳.....您可以根据需要添加特定的对象处理程序。我把它放在click reactor dvb中并独立加载。一句忠告。除非加载了acvba.arx(或者不管它叫什么),否则vba反应堆不会启动。将此代码放在ThisDrawing代码段中。
- 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
| 
