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

对不起，我不是不理你，我只是在开会&nbsp；本人&#039；我今晚试着去做

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

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

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

基思：你能发一段代码吗&nbsp；本人&#039；我的代码有一些问题，想看一看能正常工作的代码。谢谢。

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

以下是李·安布罗修斯的VBA样本链接：
http://www.hyperpics.com/customization/vb_vba/vba_downloads.aspHTH

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

这是基本的shell…您可以根据需要添加特定的对象处理程序。我将其放置在点击反应器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点击反应器