CAD

开发平台：
VBA

TlsReactor.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 = "TlsReactor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Private m_oApp As AcadApplication
Attribute m_oApp.VB_VarHelpID = -1
Private m_Entitys As New Collection
Private m_sName As String
Private m_nSelCount As Integer
Private m_Owner As TlsReactors
Public Event Modified(ByVal pObject As AcadObject, ByVal Value)
Public Event DoubleClick(ByVal pObject As AcadObject, ByVal Value)
Public Event Erased(ByVal Value)
Public Property Get Owner() As TlsReactors
On Error Resume Next
    Set Owner = m_Owner
End Property
Public Property Let Owner(ByVal vNewValue As TlsReactors)
On Error Resume Next
    Set m_Owner = vNewValue
End Property
Public Property Let Application(ByVal vNewValue As AcadApplication)
On Error Resume Next
    Set m_oApp = vNewValue
End Property
Public Property Get ActiveDocument() As AcadDocument
    Set ActiveDocument = m_oApp.ActiveDocument
End Property
Public Property Get SelCount() As Integer
    SelCount = m_nSelCount
End Property
Public Property Let SelCount(ByVal vNewValue As Integer)
    m_nSelCount = vNewValue
End Property
Public Sub InitDoc()
On Error Resume Next
    ThisDrawing
End Sub
Public Property Let Name(ByVal vNewValue As String)
    m_sName = vNewValue
End Property
Public Sub Add(ByVal Entity As AcadObject, Optional ByVal Value As Variant)
On Error Resume Next
    ThisDrawing.Add Entity, Value
    ThisDrawing.SaveData
    Change 0, Entity, Value
End Sub
Public Sub RemoveDoc(ByVal hWndStr As String)
    m_Entitys.Remove "TlsReactor_" & hWndStr
End Sub
Public Sub Change(ByVal TypeNumber As Integer, Optional ByVal Entity As AcadObject, Optional ByVal Value As Variant)
    Select Case TypeNumber
    Case 0
        RaiseEvent Modified(Entity, Value)
    Case 1
        RaiseEvent DoubleClick(Entity, Value)
    Case 2
        RaiseEvent Erased(Value)
    End Select
End Sub
Private Function ThisDrawing() As CDocument
On Error Resume Next
    Dim sName As String
    sName = "TlsReactor_" & Document.hwnd
    Set ThisDrawing = m_Entitys(sName)
    If Err Then
        Set ThisDrawing = New CDocument
        ThisDrawing.Name = m_sName
        ThisDrawing.Owner = Me
        ThisDrawing.Application = m_oApp
        ThisDrawing.LoadData
        m_Entitys.Add ThisDrawing, sName
    End If
End Function
Private Sub Class_Initialize()
    m_nSelCount = 1
End Sub

						