CAD

开发平台：

VBA

TlsReactors.cls：源码内容

							VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "TlsReactors"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Private m_oApp As AcadApplication
Private m_Events As New Collection
Private m_DoubleClickCount As Integer
Private m_DoubleClickState As Boolean
Public Property Let Application(ByVal vNewValue As AcadApplication)
On Error Resume Next
    Set m_oApp = vNewValue
    m_oApp.LoadArx "acdblclkedit.arx"
    m_oApp.UnloadArx "acdblclkedit.arx"
End Property
Public Property Get Item(ByVal Name As String) As TlsReactor
Attribute Item.VB_UserMemId = 0
On Error Resume Next
    Set Item = m_Events(Name)
    If Err Then
        Set Item = New TlsReactor
        Item.Name = Name
        Item.Application = m_oApp
        Item.Owner = Me
        m_Events.Add Item, Name
    End If
    Item.InitDoc
End Property
Public Function DoubleClick(ByVal vNewValue As Boolean)
    m_DoubleClickCount = m_DoubleClickCount + 1
    m_DoubleClickState = m_DoubleClickState Or vNewValue
    
    If m_Events.Count = m_DoubleClickCount Then
        
        If m_DoubleClickState Then
            m_DoubleClickState = False
        Else
            Dim ss As New TlsSelectionSet
            ss.Application = m_oApp
            ss.GetPickfirstSelectionSet
            
            Dim sCmdName As String
            sCmdName = "'_.properties"
            If ss.Count = 1 Then
                Select Case UCase(ss(0).ObjectName)
                Case "ACDBMTEXT"
                    sCmdName = "_.mtedit"
                Case "ACDBTEXT"
                    sCmdName = "_.ddedit" & vbCr
                Case "ACDBBLOCKREFERENCE"
                    If Left(ss(0).Name, 1) <> "*" Then
                        sCmdName = "_.refedit"
                    End If
                End Select
            End If
            m_oApp.ActiveDocument.SendCommand sCmdName & vbCr
        End If
        m_DoubleClickCount = 0
    End If
End Function
Private Sub Class_Initialize()
    m_DoubleClickState = False
    m_DoubleClickCount = 0
End Sub

						