Lesson 7.2 - alternative to DoEvents

Files

Lesson 7.2 - alternative to DoEvents

Code

Modules: DoEvents_alternative1

Public listener As clsListener
    
Sub main()
    Set listener = New clsListener
    listener.Connect
End Sub

Class Modules: clsListener

Dim WithEvents swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim WithEvents swPart As SldWorks.PartDoc
Dim WithEvents swAssy As SldWorks.AssemblyDoc
Dim WithEvents swDraw As SldWorks.DrawingDoc
    
Public Function Connect() As Boolean
    Set swApp = Application.SldWorks
    Call GetDoc
End Function
    
Private Function swAssy_NewSelectionNotify() As Long
    Call ProcessSelection(swAssy)
End Function
    
Private Function swDraw_NewSelectionNotify() As Long
    Call ProcessSelection(swDraw)
End Function
    
Private Function swPart_NewSelectionNotify() As Long
    Call ProcessSelection(swPart)
End Function
    
Private Function swApp_ActiveDocChangeNotify() As Long
    Call GetDoc
End Function
    
Private Sub GetDoc()
    Set swModel = swApp.ActiveDoc
    If Not swModel Is Nothing Then
        Select Case swModel.GetType
            Case swDocPART
                Set swPart = swModel
                Set swAssy = Nothing
                Set swDraw = Nothing
            Case swDocASSEMBLY
                Set swPart = Nothing
                Set swAssy = swModel
                Set swDraw = Nothing
            Case swDocDRAWING
                Set swPart = Nothing
                Set swAssy = Nothing
                Set swDraw = swModel
            Case Else
                Debug.Print "Failed to connect to document."
                Set clsListener = Nothing
        End Select
        Debug.Print "Successfully connected to " & swModel.GetTitle
    End If
End Sub
    
Private Sub ProcessSelection(doc As SldWorks.ModelDoc2)
    Dim swSelMgr As SldWorks.SelectionMgr
    Set swSelMgr = doc.SelectionManager
    
    If swSelMgr.GetSelectedObjectType3(1, -1) = swSelFACES Then
        If swApp.SendMsgToUser2("Face selected!" & vbCrLf & "Keep listening?", _
            swMbQuestion, swMbYesNo) = swMbHitNo Then Set listener = Nothing
    End If
End Sub