Keith™ 发表于 2006-11-9 16:36:39

对不起，我没有不理你，我刚刚在开会。今晚我会试着DL它

Keith™ 发表于 2006-11-9 16:41:54

是的，VBA反应堆..默认情况下，我保持内置反应堆关闭。
Mine基本上具有与特定类型的实体和特定命名块相关的事件。
例如，如果我双击文本，它会打开相应的文本编辑器，无论是多文本，attdef，dtext等。双击时的某些块会打开我个人增强的属性编辑器。
我过去使用过其他想法，例如，每当我放置剪切部分或细节标记时，我都可以双击它并打开或更改为适当的绘图并放大细节。

Keith™ 发表于 2006-11-15 13:45:09

基思：
你能发一段代码吗？我的代码出现了一些问题，想看一看能正常工作的代码。
谢谢。

Keith™ 发表于 2006-11-15 14:00:55

以下是 Lee Ambrosius 的 VBA 示例的链接：
http://www.hyperpics.com/customization/vb_vba/vba_downloads.asp
HTH

Keith™ 发表于 2006-11-15 14:01:46

这是基本的外壳.....您可以根据需要添加特定的对象处理程序。我把它放在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
页: 1 [2]
查看完整版本: Dbl点击反应器