Search & navigation · R10.1.1 form preflight
Assembly Part Search Tool

A SolidWorks VBA search and navigation tool for large assemblies, with ranked text matching and temporary visibility isolation.
Code availableEngineering case study ↗Read actual source ↓
ENGINEERING CONTRIBUTION
Designed the component index, ranked search, result interaction, isolation/restore workflow, and form integration contract.
Prerequisites

SolidWorks on Windows with an active assembly and SolidWorks VBA/API references.
Microsoft Forms controls and the matching frmPartSearch form resources.
The Windows API declarations and pointer types must match the host VBA architecture.
Additional setup

Requires the matching frmPartSearch .frm/.frx resources and form event wiring.
SOURCE WALKTHROUGH
How the workflow fits together.

01
Preflight the host and form
main connects to the active assembly, clears stale wheel hooks, builds the component index, and separately loads and validates the form before displaying it.
02
Rank component names
Candidate scoring combines starts-with and contains matches, token coverage and edit-distance similarity. The result map links each list row to a component; the configured display limit is 100 results.
03
Navigate and isolate
Form callbacks select, preview and zoom components. Isolation stores visibility state; switching selection exits the prior isolate, verifies the new selection and reapplies isolation.
04
Restore transient state
Cleanup restores visibility and removes temporary window subclassing. APS_EmergencyCleanup provides a recovery entry point.
Output & model changes

Changes selection, component visibility and view zoom in the active assembly.
Temporarily subclasses form/focus windows for mouse-wheel events.
APS_ENABLE_FILE_LOG enables file logging, including model/session details.
CODE & ENTRY POINTS
Read the implementation.

Find a procedure, follow an API call or download the module for your SolidWorks setup.
AssemblyPartSearch.bas

Standard module containing ranked component search, result-to-component mapping, visibility snapshots, isolate transitions and temporary mouse-wheel window subclassing.
VBA · 4,505 lines
Download .bas
Entry points
API & integration calls
Attribute VB_Name = "modAssemblySearch"
Option Explicit

'===========================================================
' ASSEMBLY PART SEARCH - APS_R10_1_1_FORM_PREFLIGHT
' SOLIDWORKS VBA
'
' BUILD: 2026-09-22 R10.1.1 FORM PREFLIGHT + BULK FAST ISOLATE + R9 WHEEL
'
' IMPORTANT CHANGES IN R8
' ----------------------------------------------------------
' 1) Dynamic isolate mode is NEVER cleared by
'    IsCommandEnabled(). The previous code incorrectly
'    treated command availability as isolate state.
'
' 2) Dynamic isolate switch is:
'       Exit old isolate
'       Select NEW list item(s)
'       Verify selection count
'       Isolate NEW selection
'       Reselect
'       Zoom to NEW selection
'
' 3) ListBox.Change does NOT launch isolate operations.
'    MouseUp / KeyUp are used after MSForms selection has
'    fully settled.
'
' 4) Mouse wheel uses temporary subclassing only.
'
' 5) Both the UserForm window AND the currently focused
'    child window are subclassed while the pointer is over
'    the result list. WM_MOUSEWHEEL is normally delivered to
'    the focus window, so this covers both routing paths.
'===========================================================


'===========================================================
' SEARCH SETTINGS
'===========================================================

Private Const APS_BUILD_ID As String = "APS_R10_1_1_FORM_PREFLIGHT_2026-09-22"

Private Const APS_MAX_RESULTS As Long = 100
Private Const APS_MIN_FUZZY_LENGTH As Long = 3
Private Const APS_MIN_DISPLAY_SCORE As Double = 300
Private Const APS_SKIP_FUZZY_SCORE As Double = 800

Private Const APS_ENABLE_FILE_LOG As Boolean = True


'===========================================================
' FAST ISOLATE VISIBILITY CONSTANTS
'
' swComponentVisibilityState_e:
'   Hidden  = 0
'   Visible = 1
'
' R9 FAST ISOLATE does NOT use native IAssemblyDoc.Isolate.
'===========================================================

Private Const APS_COMPONENT_HIDDEN As Long = 0
Private Const APS_COMPONENT_VISIBLE As Long = 1
Private Const APS_VISIBILITY_UNKNOWN As Long = -9999
Private Const APS_MAX_PARENT_DEPTH As Long = 64


'===========================================================
' SOLIDWORKS OBJECTS
'===========================================================

Private APS_swApp As SldWorks.SldWorks
Private APS_swModel As SldWorks.ModelDoc2
Private APS_swAssy As SldWorks.AssemblyDoc


'===========================================================
' COMPONENT INDEX
'===========================================================

Private APS_Components() As SldWorks.Component2

Private APS_BaseName() As String
Private APS_LeafName() As String
Private APS_FullName() As String

Private APS_BaseNorm() As String
Private APS_LeafNorm() As String
Private APS_FullNorm() As String

Private APS_BaseCompact() As String
Private APS_LeafCompact() As String
Private APS_FullCompact() As String

Public APS_ComponentCount As Long


'===========================================================
' ALL COMPONENT INSTANCES
'
' APS_Components() contains searchable PART instances only.
' APS_AllComponents() also contains subassembly components.
'
' All-component storage is required so Fast Isolate can
' snapshot and restore the exact pre-isolate visibility
' state, including hidden subassembly parents.
'===========================================================

Private APS_AllComponents() As SldWorks.Component2
Private APS_AllIsPart() As Boolean
Private APS_AllCount As Long


'===========================================================
' FAST ISOLATE STATE
'===========================================================

Private APS_FastIsolateActive As Boolean
Private APS_FastSnapshotValid As Boolean

Private APS_OriginalVisibility() As Long
Private APS_FastCurrentVisiblePart() As Boolean

Private APS_LastIsolateSelectionSignature As String


'===========================================================
' RESULT MAP
'===========================================================

Private APS_ResultMap() As Long


'===========================================================
' UI / RE-ENTRY STATE
'===========================================================

Public APS_UpdatingResults As Boolean
Public APS_PreviewComponentIndex As Long

Private APS_SelectionBusy As Boolean
Private APS_IsolationBusy As Boolean
Private APS_DynamicIsolateBusy As Boolean


'===========================================================
' FAST ISOLATE MODE
'
' Fast Isolate is a temporary visibility layer maintained
' by this macro:
'
'   Enter once:
'       snapshot component visibility
'       hide non-selected part instances
'
'   Switch:
'       hide only parts leaving the selection
'       show only parts entering the selection
'
'   Exit:
'       restore the exact visibility snapshot
'
' No native ExitIsolate/Isolate cycle occurs during browsing.
'===========================================================


'===========================================================
' RIGHT CLICK SELECTION MEMORY
'===========================================================

Private APS_RightClickSelection() As Boolean
Private APS_RightClickListCount As Long
Private APS_RightClickSelectedCount As Long


'===========================================================
' DEBUG STATE
'===========================================================

Private APS_LogFilePath As String
Private APS_LogSessionStarted As Boolean
Private APS_CurrentOperation As String
Private APS_CurrentStep As String
Private APS_LastSubclassError As String


'===========================================================
' MOUSE WHEEL SUBCLASS STATE
'
' We subclass:
'   A) the UserForm top-level window
'   B) the currently focused child window, when it belongs
'      to the UserForm
'
' This captures WM_MOUSEWHEEL whether it is delivered first
' to the focused MSForms child or propagated to the form.
'===========================================================

Private Const APS_GWLP_WNDPROC As Long = -4
Private Const APS_WM_MOUSEWHEEL As Long = &H20A
Private Const APS_WHEEL_DELTA As Long = 120
Private Const APS_SCROLL_LINES As Long = 3

Private APS_FormHwnd As LongPtr
Private APS_FormOriginalWndProc As LongPtr
Private APS_FormSubclassInstalled As Boolean

Private APS_FocusHwnd As LongPtr
Private APS_FocusOriginalWndProc As LongPtr
Private APS_FocusSubclassInstalled As Boolean

Private APS_MouseOverList As Boolean
Private APS_WheelBusy As Boolean
Private APS_WheelRemainder As Long
Private APS_WheelTarget As Object

Private APS_WheelEventCount As Long
Private APS_LastWheelDelta As Long
Private APS_WheelShuttingDown As Boolean


'===========================================================
' CONTEXT MENU
'===========================================================

Private Const APS_MF_STRING As Long = &H0&
Private Const APS_MF_SEPARATOR As Long = &H800&

Private Const APS_TPM_LEFTALIGN As Long = &H0&
Private Const APS_TPM_RIGHTBUTTON As Long = &H2&
Private Const APS_TPM_NONOTIFY As Long = &H80&
Private Const APS_TPM_RETURNCMD As Long = &H100&

Private Const APS_WM_NULL As Long = 0

Private Const APS_MENU_ISOLATE As Long = 11001
Private Const APS_MENU_EXIT_ISOLATE As Long = 11002
Private Const APS_MENU_DIAGNOSTICS As Long = 11003


'===========================================================
' WINDOWS POINT
'===========================================================

Private Type APS_POINTAPI
    X As Long
    Y As Long
End Type


'===========================================================
' WINDOWS API - SUBCLASS / WHEEL
'===========================================================

Private Declare PtrSafe Function APS_FindWindow _
    Lib "user32" _
    Alias "FindWindowA" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) As LongPtr

Private Declare PtrSafe Function APS_GetFocus _
    Lib "user32" _
    Alias "GetFocus" () As LongPtr

Private Declare PtrSafe Function APS_IsWindow _
    Lib "user32" _
    Alias "IsWindow" ( _
        ByVal hWnd As LongPtr) As Long

Private Declare PtrSafe Function APS_IsChild _
    Lib "user32" _
    Alias "IsChild" ( _
        ByVal hWndParent As LongPtr, _
        ByVal hWnd As LongPtr) As Long

Private Declare PtrSafe Function APS_GetClassName _
    Lib "user32" _
    Alias "GetClassNameA" ( _
        ByVal hWnd As LongPtr, _
        ByVal lpClassName As String, _
        ByVal nMaxCount As Long) As Long

#If Win64 Then

Private Declare PtrSafe Function APS_SetWindowLongPtr _
    Lib "user32" _
    Alias "SetWindowLongPtrA" ( _
        ByVal hWnd As LongPtr, _
        ByVal nIndex As Long, _
        ByVal dwNewLong As LongPtr) As LongPtr

#Else

Private Declare PtrSafe Function APS_SetWindowLongPtr _
    Lib "user32" _
    Alias "SetWindowLongA" ( _
        ByVal hWnd As LongPtr, _
        ByVal nIndex As Long, _
        ByVal dwNewLong As LongPtr) As LongPtr

#End If

Private Declare PtrSafe Function APS_CallWindowProc _
    Lib "user32" _
    Alias "CallWindowProcA" ( _
        ByVal lpPrevWndFunc As LongPtr, _
        ByVal hWnd As LongPtr, _
        ByVal Msg As Long, _
        ByVal wParam As LongPtr, _
        ByVal lParam As LongPtr) As LongPtr

Private Declare PtrSafe Function APS_GetLastError _
    Lib "kernel32" _
    Alias "GetLastError" () As Long

Private Declare PtrSafe Sub APS_SetLastError _
    Lib "kernel32" _
    Alias "SetLastError" ( _
        ByVal dwErrCode As Long)


'===========================================================
' WINDOWS API - POPUP MENU
'===========================================================

Private Declare PtrSafe Function APS_CreatePopupMenu _
    Lib "user32" _
    Alias "CreatePopupMenu" () As LongPtr

Private Declare PtrSafe Function APS_DestroyMenu _
    Lib "user32" _
    Alias "DestroyMenu" ( _
        ByVal hMenu As LongPtr) As Long

Private Declare PtrSafe Function APS_AppendMenu _
    Lib "user32" _
    Alias "AppendMenuA" ( _
        ByVal hMenu As LongPtr, _
        ByVal uFlags As Long, _
        ByVal uIDNewItem As LongPtr, _
        ByVal lpNewItem As String) As Long

Private Declare PtrSafe Function APS_TrackPopupMenu _
    Lib "user32" _
    Alias "TrackPopupMenu" ( _
        ByVal hMenu As LongPtr, _
        ByVal uFlags As Long, _
        ByVal X As Long, _
        ByVal Y As Long, _
        ByVal nReserved As Long, _
        ByVal hWnd As LongPtr, _
        ByVal prcRect As LongPtr) As Long

Private Declare PtrSafe Function APS_GetCursorPos _
    Lib "user32" _
    Alias "GetCursorPos" ( _
        ByRef lpPoint As APS_POINTAPI) As Long

Private Declare PtrSafe Function APS_GetForegroundWindow _
    Lib "user32" _
    Alias "GetForegroundWindow" () As LongPtr

Private Declare PtrSafe Function APS_SetForegroundWindow _
    Lib "user32" _
    Alias "SetForegroundWindow" ( _
        ByVal hWnd As LongPtr) As Long

Private Declare PtrSafe Function APS_PostMessage _
    Lib "user32" _
    Alias "PostMessageA" ( _
        ByVal hWnd As LongPtr, _
        ByVal wMsg As Long, _
        ByVal wParam As LongPtr, _
        ByVal lParam As LongPtr) As Long


'===========================================================
' LOGGING
'===========================================================

Private Sub APS_StartDebugSession()

    Dim ff As Integer

    On Error Resume Next

    APS_LogFilePath = _
        Environ$("TEMP") & _
        "\AssemblyPartSearch_Debug.log"

    APS_LogSessionStarted = True

    If APS_ENABLE_FILE_LOG Then

        ff = FreeFile

        Open APS_LogFilePath For Append As #ff

        Print #ff, ""
        Print #ff, String$(80, "=")
        Print #ff, "NEW SESSION: " & Format$(Now, "yyyy-mm-dd hh:nn:ss")
        Print #ff, "BUILD: " & APS_BUILD_ID
        Print #ff, String$(80, "=")

        Close #ff

    End If

    APS_Log "SESSION", "Diagnostic session started"
    APS_Log "SESSION", "BUILD=" & APS_BUILD_ID
    APS_Log "SESSION", "Log file=" & APS_LogFilePath

    On Error GoTo 0

End Sub


Public Sub APS_Log( _
    ByVal category As String, _
    ByVal message As String)

    Dim outputLine As String
    Dim ff As Integer

    On Error Resume Next

    If Not APS_LogSessionStarted Then

        APS_LogFilePath = _
            Environ$("TEMP") & _
            "\AssemblyPartSearch_Debug.log"

        APS_LogSessionStarted = True

    End If

    outputLine = _
        Format$(Now, "hh:nn:ss") & _
        " | " & category & _
        " | " & message

    Debug.Print outputLine

    If APS_ENABLE_FILE_LOG Then

        ff = FreeFile

        Open APS_LogFilePath For Append As #ff
        Print #ff, outputLine
        Close #ff

    End If

    On Error GoTo 0

End Sub


Private Sub APS_SetStep( _
    ByVal operationName As String, _
    ByVal stepName As String)

    APS_CurrentOperation = operationName
    APS_CurrentStep = stepName

    APS_Log operationName, "STEP: " & stepName

End Sub


Private Sub APS_LogError( _
    ByVal procedureName As String, _
    ByVal stepName As String, _
    ByVal errorNumber As Long, _
    ByVal errorDescription As String, _
    ByVal errorSource As String)

    APS_Log _
        "ERROR", _
        procedureName & _
        " | Step=" & stepName & _
        " | Err=" & CStr(errorNumber) & _
        " | Hex=" & Hex$(errorNumber) & _
        " | Description=" & errorDescription & _
        " | Source=" & errorSource

End Sub


Private Sub APS_ShowDiagnosticError( _
    ByVal procedureName As String, _
    ByVal stepName As String, _
    ByVal errorNumber As Long, _
    ByVal errorDescription As String)

    MsgBox _
        "Assembly Part Search error." & _
        vbCrLf & vbCrLf & _
        "Procedure: " & procedureName & _
        vbCrLf & _
        "Step: " & stepName & _
        vbCrLf & _
        "Error: " & CStr(errorNumber) & _
        vbCrLf & _
        "Description: " & errorDescription & _
        vbCrLf & vbCrLf & _
        "Log:" & vbCrLf & APS_LogFilePath, _
        vbExclamation, _
        "Assembly Part Search"

End Sub


Public Sub APS_PrintDiagnostics()

    APS_Log "DIAGNOSTICS", "BUILD=" & APS_BUILD_ID
    APS_Log "DIAGNOSTICS", "ComponentCount=" & CStr(APS_ComponentCount)
    APS_Log "DIAGNOSTICS", "UpdatingResults=" & CStr(APS_UpdatingResults)
    APS_Log "DIAGNOSTICS", "SelectionBusy=" & CStr(APS_SelectionBusy)
    APS_Log "DIAGNOSTICS", "IsolationBusy=" & CStr(APS_IsolationBusy)
    APS_Log "DIAGNOSTICS", "DynamicIsolateBusy=" & CStr(APS_DynamicIsolateBusy)
    APS_Log "DIAGNOSTICS", "FastIsolateActive=" & CStr(APS_FastIsolateActive)
    APS_Log "DIAGNOSTICS", "FastSnapshotValid=" & CStr(APS_FastSnapshotValid)
    APS_Log "DIAGNOSTICS", "AllComponentCount=" & CStr(APS_AllCount)
    APS_Log "DIAGNOSTICS", "IsolateSignature=" & APS_LastIsolateSelectionSignature

    APS_Log "DIAGNOSTICS", "FormSubclassInstalled=" & CStr(APS_FormSubclassInstalled)
    APS_Log "DIAGNOSTICS", "FormHwnd=" & CStr(APS_FormHwnd)
    APS_Log "DIAGNOSTICS", "FormClass=" & APS_GetWindowClassName(APS_FormHwnd)

    APS_Log "DIAGNOSTICS", "FocusSubclassInstalled=" & CStr(APS_FocusSubclassInstalled)
    APS_Log "DIAGNOSTICS", "FocusHwnd=" & CStr(APS_FocusHwnd)
    APS_Log "DIAGNOSTICS", "FocusClass=" & APS_GetWindowClassName(APS_FocusHwnd)

    APS_Log "DIAGNOSTICS", "WheelEventCount=" & CStr(APS_WheelEventCount)
    APS_Log "DIAGNOSTICS", "LastWheelDelta=" & CStr(APS_LastWheelDelta)

    APS_Log "DIAGNOSTICS", "CurrentOperation=" & APS_CurrentOperation
    APS_Log "DIAGNOSTICS", "CurrentStep=" & APS_CurrentStep

    If Len(APS_LastSubclassError) > 0 Then
        APS_Log "DIAGNOSTICS", "LastSubclassError=" & APS_LastSubclassError
    End If

End Sub


'===========================================================
' MAIN
'===========================================================

Public Sub main()

    Dim stepName As String

    Dim savedErrNumber As Long
    Dim savedErrDescription As String
    Dim savedErrSource As String

    Dim formValidationMessage As String

    On Error GoTo MainError

    APS_StartDebugSession

    APS_Log "MAIN", "BUILD=" & APS_BUILD_ID

    stepName = "Remove previous wheel subclass"
    APS_SetStep "MAIN", stepName
    APS_DisableWheelSubclass

    stepName = "Connect to SOLIDWORKS"
    APS_SetStep "MAIN", stepName
    Set APS_swApp = Application.SldWorks

    stepName = "Get active document"
    APS_SetStep "MAIN", stepName
    Set APS_swModel = APS_swApp.ActiveDoc

    If APS_swModel Is Nothing Then

        MsgBox _
            "Open a SOLIDWORKS assembly first.", _
            vbExclamation, _
            "Assembly Part Search"

        Exit Sub

    End If

    If APS_swModel.GetType <> swDocASSEMBLY Then

        MsgBox _
            "The active document must be a SOLIDWORKS assembly.", _
            vbExclamation, _
            "Assembly Part Search"

        Exit Sub

    End If

    Set APS_swAssy = APS_swModel

    APS_UpdatingResults = False
    APS_PreviewComponentIndex = -1

    APS_SelectionBusy = False
    APS_IsolationBusy = False
    APS_DynamicIsolateBusy = False

    APS_FastIsolateActive = False
    APS_FastSnapshotValid = False
    APS_LastIsolateSelectionSignature = ""

    APS_WheelEventCount = 0
    APS_LastWheelDelta = 0

    stepName = "Build component index"
    APS_SetStep "MAIN", stepName

    If Not APS_BuildComponentIndex() Then

        MsgBox _
            "No searchable part components were found.", _
            vbInformation, _
            "Assembly Part Search"

        Exit Sub

    End If

    APS_Log _
        "MAIN", _
        "Indexed parts=" & CStr(APS_ComponentCount)

    '-------------------------------------------------------
    ' FORM RESOURCE PREFLIGHT
    '
    ' Load is intentionally separated from Show.
    '
    ' If Microsoft Forms cannot instantiate the UserForm or
    ' one of its stored controls, the log now reports:
    '
    '   MAIN | STEP: Load frmPartSearch resource
    '
    ' rather than vaguely blaming Show.
    '-------------------------------------------------------

    stepName = "Load frmPartSearch resource"
    APS_SetStep "MAIN", stepName

    Load frmPartSearch

    APS_Log _
        "FORM_PREFLIGHT", _
        "frmPartSearch resource loaded successfully"

    stepName = "Validate frmPartSearch controls"
    APS_SetStep "MAIN", stepName

    If Not APS_ValidatePartSearchForm( _
        frmPartSearch, _
        formValidationMessage) Then

        Err.Raise _
            vbObjectError + 2201, _
            "APS_ValidatePartSearchForm", _
            formValidationMessage

    End If

    APS_Log _
        "FORM_PREFLIGHT", _
        "Required controls validated"

    stepName = "Show form"
    APS_SetStep "MAIN", stepName

    frmPartSearch.Show vbModeless

    APS_Log _
        "MAIN", _
        "Search form shown"

    Exit Sub

MainError:

    'CRITICAL:
    'Cache Err BEFORE logging/file I/O. The prior build could
    'display Error 0 because APS_LogError changed Err state.
    savedErrNumber = Err.Number
    savedErrDescription = Err.Description
    savedErrSource = Err.Source

    APS_LogError _
        "MAIN", _
        stepName, _
        savedErrNumber, _
        savedErrDescription, _
        savedErrSource

    APS_ShowDiagnosticError _
        "MAIN", _
        stepName, _
        savedErrNumber, _
        savedErrDescription

End Sub



'===========================================================
' FORM PREFLIGHT VALIDATION
'===========================================================

Private Function APS_ValidatePartSearchForm( _
    ByVal frm As Object, _
    ByRef validationMessage As String) As Boolean

    Dim ctl As Object

    APS_ValidatePartSearchForm = False
    validationMessage = ""

    On Error GoTo ValidationError

    Set ctl = frm.Controls("txtSearch")
    If TypeName(ctl) <> "TextBox" Then
        validationMessage = _
            "txtSearch exists but is not a TextBox."
        Exit Function
    End If

    Set ctl = frm.Controls("lstResults")
    If TypeName(ctl) <> "ListBox" Then
        validationMessage = _
            "lstResults exists but is not a ListBox."
        Exit Function
    End If

    Set ctl = frm.Controls("lblStatus")
    If TypeName(ctl) <> "Label" Then
        validationMessage = _
            "lblStatus exists but is not a Label."
        Exit Function
    End If

    Set ctl = frm.Controls("chkZoom")
    If TypeName(ctl) <> "CheckBox" Then
        validationMessage = _
            "chkZoom exists but is not a CheckBox."
        Exit Function
    End If

    Set ctl = frm.Controls("cmdRefresh")
    If TypeName(ctl) <> "CommandButton" Then
        validationMessage = _
            "cmdRefresh exists but is not a CommandButton."
        Exit Function
    End If

    Set ctl = frm.Controls("cmdClose")
    If TypeName(ctl) <> "CommandButton" Then
        validationMessage = _
            "cmdClose exists but is not a CommandButton."
        Exit Function
    End If

    APS_ValidatePartSearchForm = True

    Exit Function

ValidationError:

    validationMessage = _
        "UserForm control validation failed." & _
        " Missing or damaged control near: " & _
        Err.Description & _
        " (Err " & CStr(Err.Number) & ")."

End Function


'===========================================================
' EMERGENCY CLEANUP
'===========================================================

Public Sub APS_EmergencyCleanup()

    APS_Log "CLEANUP", "Emergency cleanup START"

    On Error Resume Next

    APS_DisableWheelSubclass

    If APS_FastSnapshotValid Then
        APS_RestoreFastVisibilitySnapshot "EMERGENCY_CLEANUP"
    End If

    APS_FastIsolateActive = False
    APS_FastSnapshotValid = False
    APS_LastIsolateSelectionSignature = ""

    APS_IsolationBusy = False
    APS_DynamicIsolateBusy = False
    APS_SelectionBusy = False
    APS_UpdatingResults = False

    APS_Log "CLEANUP", "Emergency cleanup END"

    On Error GoTo 0

End Sub


'===========================================================
' BUILD COMPONENT INDEX
'===========================================================

Public Function APS_BuildComponentIndex() As Boolean

    Dim vComponents As Variant
    Dim swComp As SldWorks.Component2

    Dim i As Long
    Dim idx As Long
    Dim allIdx As Long
    Dim maxIndex As Long

    Dim pathName As String
    Dim baseName As String
    Dim leafName As String
    Dim fullName As String

    Dim isPart As Boolean

    Dim started As Double
    Dim elapsed As Double

    Dim stepName As String

    On Error GoTo BuildError

    started = Timer

    APS_BuildComponentIndex = False
    APS_ComponentCount = 0
    APS_AllCount = 0

    Set APS_swApp = Application.SldWorks
    Set APS_swModel = APS_swApp.ActiveDoc

    If APS_swModel Is Nothing Then Exit Function
    If APS_swModel.GetType <> swDocASSEMBLY Then Exit Function

    Set APS_swAssy = APS_swModel

    stepName = "GetComponents(False)"
    APS_SetStep "BUILD_INDEX", stepName

    vComponents = APS_swAssy.GetComponents(False)

    If IsEmpty(vComponents) Then Exit Function
    If Not IsArray(vComponents) Then Exit Function

    maxIndex = UBound(vComponents) - LBound(vComponents)

    ReDim APS_Components(0 To maxIndex)

    ReDim APS_BaseName(0 To maxIndex)
    ReDim APS_LeafName(0 To maxIndex)
    ReDim APS_FullName(0 To maxIndex)

    ReDim APS_BaseNorm(0 To maxIndex)
    ReDim APS_LeafNorm(0 To maxIndex)
    ReDim APS_FullNorm(0 To maxIndex)

    ReDim APS_BaseCompact(0 To maxIndex)
    ReDim APS_LeafCompact(0 To maxIndex)
    ReDim APS_FullCompact(0 To maxIndex)

    ReDim APS_AllComponents(0 To maxIndex)
    ReDim APS_AllIsPart(0 To maxIndex)

    ReDim APS_ResultMap(0 To APS_MAX_RESULTS - 1)

    APS_ResetResultMap

    idx = 0
    allIdx = 0

    For i = LBound(vComponents) To UBound(vComponents)

        Set swComp = vComponents(i)

        If Not swComp Is Nothing Then

            isPart = APS_IsPartComponent(swComp)

            Set APS_AllComponents(allIdx) = swComp
            APS_AllIsPart(allIdx) = isPart
            allIdx = allIdx + 1

            If isPart Then

                pathName = APS_SafeGetPath(swComp)
                fullName = APS_SafeGetComponentName(swComp)

                baseName = APS_GetFileBaseName(pathName)
                leafName = APS_GetLeafComponentName(fullName)

                If Len(baseName) = 0 Then
                    baseName = APS_RemoveInstanceSuffix(leafName)
                End If

                Set APS_Components(idx) = swComp

                APS_BaseName(idx) = baseName
                APS_LeafName(idx) = leafName
                APS_FullName(idx) = fullName

                APS_BaseNorm(idx) = APS_NormalizeText(baseName)
                APS_LeafNorm(idx) = APS_NormalizeText(leafName)
                APS_FullNorm(idx) = APS_NormalizeText(fullName)

                APS_BaseCompact(idx) = APS_CompactText(baseName)
                APS_LeafCompact(idx) = APS_CompactText(leafName)
                APS_FullCompact(idx) = APS_CompactText(fullName)

                idx = idx + 1

            End If

        End If

    Next i

    APS_ComponentCount = idx
    APS_AllCount = allIdx

    If APS_ComponentCount > 0 Then
        ReDim APS_FastCurrentVisiblePart(0 To APS_ComponentCount - 1)
    End If

    APS_PreviewComponentIndex = -1

    APS_BuildComponentIndex = _
        (APS_ComponentCount > 0)

    elapsed = Timer - started

    If elapsed < 0 Then
        elapsed = elapsed + 86400
    End If

    APS_Log _
        "BUILD_INDEX", _
        "Parts=" & CStr(APS_ComponentCount) & _
        " | All components=" & CStr(APS_AllCount) & _
        " | Time=" & Format$(elapsed, "0.000") & " sec"

    Exit Function

BuildError:

    APS_LogError _
        "APS_BuildComponentIndex", _
        stepName, _
        Err.Number, _
        Err.Description, _
        Err.Source

    APS_BuildComponentIndex = False

End Function

Private Sub APS_ResetResultMap()

    Dim i As Long

    For i = 0 To APS_MAX_RESULTS - 1
        APS_ResultMap(i) = -1
    Next i

End Sub


Private Function APS_IsPartComponent( _
    ByVal swComp As SldWorks.Component2) As Boolean

    Dim pathName As String
    Dim swDoc As SldWorks.ModelDoc2

    APS_IsPartComponent = False

    On Error Resume Next

    pathName = LCase$(swComp.GetPathName)

    If Right$(pathName, 7) = ".sldprt" Then

        APS_IsPartComponent = True

        On Error GoTo 0

        Exit Function

    End If

    Set swDoc = swComp.GetModelDoc2

    If Not swDoc Is Nothing Then

        If swDoc.GetType = swDocPART Then
            APS_IsPartComponent = True
        End If

    End If

    On Error GoTo 0

End Function


Private Function APS_IsIndexedAssemblyActive() As Boolean

    Dim activeModel As SldWorks.ModelDoc2

    APS_IsIndexedAssemblyActive = False

    If APS_swApp Is Nothing Then Exit Function
    If APS_swModel Is Nothing Then Exit Function

    Set activeModel = APS_swApp.ActiveDoc

    If activeModel Is Nothing Then Exit Function
    If activeModel.GetType <> swDocASSEMBLY Then Exit Function

    On Error Resume Next

    APS_IsIndexedAssemblyActive = _
        (StrComp( _
            activeModel.GetTitle, _
            APS_swModel.GetTitle, _
            vbTextCompare) = 0)

    On Error GoTo 0

End Function


'===========================================================
' SEARCH
'===========================================================

Public Sub APS_UpdateSearchResults( _
    ByVal frm As Object, _
    ByVal rawQuery As String)

    Dim queryNorm As String

    Dim scores(0 To APS_MAX_RESULTS - 1) As Double
    Dim indices(0 To APS_MAX_RESULTS - 1) As Long

    Dim i As Long
    Dim j As Long

    Dim score As Double
    Dim resultCount As Long

    Dim started As Double
    Dim elapsed As Double

    Dim stepName As String

    If APS_UpdatingResults Then Exit Sub

    If Not APS_IsIndexedAssemblyActive() Then

        frm.lstResults.Clear
        frm.lstResults.Visible = False

        frm.lblStatus.Caption = _
            "Active assembly changed - click Refresh"

        Exit Sub

    End If

    On Error GoTo SearchError

    started = Timer

    APS_UpdatingResults = True

    queryNorm = APS_NormalizeText(rawQuery)

    APS_Log "SEARCH", "Query=""" & rawQuery & """"

    frm.lstResults.Clear

    If Len(queryNorm) = 0 Then

        frm.lstResults.Visible = False

        frm.lblStatus.Caption = _
            CStr(APS_ComponentCount) & " parts indexed"

        APS_PreviewComponentIndex = -1
        APS_UpdatingResults = False

        Exit Sub

    End If

    For i = 0 To APS_MAX_RESULTS - 1

        scores(i) = -1
        indices(i) = -1
        APS_ResultMap(i) = -1

    Next i

    stepName = "Score components"

    For i = 0 To APS_ComponentCount - 1

        score = APS_ScoreCandidate(rawQuery, i)

        If score >= APS_MIN_DISPLAY_SCORE Then

            APS_InsertRankedResult _
                score, _
                i, _
                scores, _
                indices

        End If

    Next i

    resultCount = 0

    For j = 0 To APS_MAX_RESULTS - 1

        If indices(j) >= 0 Then

            APS_ResultMap(resultCount) = indices(j)

            frm.lstResults.AddItem _
                APS_BaseName(indices(j)) & _
                "    -    " & _
                APS_FullName(indices(j))

            resultCount = resultCount + 1

        End If

    Next j

    If resultCount = 0 Then

        frm.lstResults.Visible = False
        frm.lblStatus.Caption = "No close matches"

        APS_PreviewComponentIndex = -1
        APS_UpdatingResults = False

        Exit Sub

    End If

    'Highest-ranked result is selected by default.
    frm.lstResults.Visible = True

    frm.lstResults.Selected(0) = True
    frm.lstResults.ListIndex = 0
    frm.lstResults.TopIndex = 0

    If resultCount = 1 Then

        frm.lblStatus.Caption = "1 match"

    Else

        frm.lblStatus.Caption = _
            CStr(resultCount) & " best matches"

    End If

    APS_UpdatingResults = False

    APS_Log _
        "SEARCH", _
        "Results=" & CStr(resultCount) & _
        " | Top=""" & _
        APS_BaseName(APS_ResultMap(0)) & """"

    'CRITICAL:
    'No command-enabled isolate-state probing here.
    If APS_FastIsolateActive Then

        APS_DynamicSwitchIsolate _
            frm, _
            frm.chkZoom.Value

    Else

        APS_PreviewBestResult _
            frm.chkZoom.Value

    End If

    elapsed = Timer - started

    If elapsed < 0 Then
        elapsed = elapsed + 86400
    End If

    APS_Log _
        "SEARCH", _
        "Completed in " & _
        Format$(elapsed, "0.000") & _
        " sec"

    Exit Sub

SearchError:

    APS_UpdatingResults = False

    APS_LogError _
        "APS_UpdateSearchResults", _
        stepName, _
        Err.Number, _
        Err.Description, _
        Err.Source

    frm.lblStatus.Caption = _
        "Search error - see diagnostics"

End Sub


'===========================================================
' SEARCH SCORING
'===========================================================

Private Function APS_ScoreCandidate( _
    ByVal query As String, _
    ByVal componentIndex As Long) As Double

    Dim q As String
    Dim qc As String

    Dim bestScore As Double
    Dim score As Double
    Dim similarity As Double
    Dim tokenScore As Double

    q = APS_NormalizeText(query)
    qc = APS_CompactText(query)

    If Len(q) = 0 Then Exit Function

    bestScore = 0

    'Exact.
    If q = APS_BaseNorm(componentIndex) Then
        APS_ScoreCandidate = 1000
        Exit Function
    End If

    If qc = APS_BaseCompact(componentIndex) Then
        APS_ScoreCandidate = 995
        Exit Function
    End If

    If q = APS_LeafNorm(componentIndex) Then
        APS_ScoreCandidate = 990
        Exit Function
    End If

    'Prefix.
    score = _
        APS_StartsWithScore( _
            q, _
            APS_BaseNorm(componentIndex), _
            950)

    If score > bestScore Then bestScore = score

    score = _
        APS_StartsWithScore( _
            q, _
            APS_LeafNorm(componentIndex), _
            935)

    If score > bestScore Then bestScore = score

    score = _
        APS_StartsWithScore( _
            q, _
            APS_FullNorm(componentIndex), _
            900)

    If score > bestScore Then bestScore = score

    'Contains.
    score = _
        APS_ContainsScore( _
            q, _
            APS_BaseNorm(componentIndex), _
            900)

    If score > bestScore Then bestScore = score

    score = _
        APS_ContainsScore( _
            q, _
            APS_LeafNorm(componentIndex), _
            875)

    If score > bestScore Then bestScore = score

    score = _
        APS_ContainsScore( _
            q, _
            APS_FullNorm(componentIndex), _
            830)

    If score > bestScore Then bestScore = score

    'Separator-independent.
    If Len(qc) > 0 Then

        If qc = APS_LeafCompact(componentIndex) Then
            If bestScore < 925 Then bestScore = 925
        End If

        If InStr( _
            1, _
            APS_BaseCompact(componentIndex), _
            qc, _
            vbTextCompare) > 0 Then

            If bestScore < 870 Then bestScore = 870

        End If

        If InStr( _
            1, _
            APS_LeafCompact(componentIndex), _
            qc, _
            vbTextCompare) > 0 Then

            If bestScore < 850 Then bestScore = 850

        End If

        If InStr( _
            1, _
            APS_FullCompact(componentIndex), _
            qc, _
            vbTextCompare) > 0 Then

            If bestScore < 810 Then bestScore = 810

        End If

    End If

    'Token coverage.
    tokenScore = _
        APS_TokenCoverageScore( _
            q, _
            APS_BaseNorm(componentIndex) & _
            " " & _
            APS_LeafNorm(componentIndex) & _
            " " & _
            APS_FullNorm(componentIndex))

    If tokenScore >= 1 Then
        score = 825
    Else
        score = tokenScore * 720
    End If

    If score > bestScore Then bestScore = score

    'Fuzzy only when conventional matching is not already
    'strong.
    If bestScore < APS_SKIP_FUZZY_SCORE Then

        If Len(qc) >= APS_MIN_FUZZY_LENGTH Then

            similarity = _
                APS_StringSimilarity( _
                    qc, _
                    APS_BaseCompact(componentIndex))

            score = similarity * 760

            If score > bestScore Then bestScore = score

            similarity = _
                APS_StringSimilarity( _
                    qc, _
                    APS_LeafCompact(componentIndex))

            score = similarity * 730

            If score > bestScore Then bestScore = score

            similarity = _
                APS_BestTokenSimilarity( _
                    q, _
                    APS_BaseNorm(componentIndex) & _
                    " " & _
                    APS_LeafNorm(componentIndex))

            score = similarity * 710

            If score > bestScore Then bestScore = score

        End If

    End If

    APS_ScoreCandidate = bestScore

End Function


Private Function APS_StartsWithScore( _
    ByVal query As String, _
    ByVal candidate As String, _
    ByVal baseScore As Double) As Double

    If Len(query) = 0 Then Exit Function
    If Len(candidate) < Len(query) Then Exit Function

    If Left$(candidate, Len(query)) = query Then

        APS_StartsWithScore = _
            baseScore - _
            ((Len(candidate) - Len(query)) * 0.05)

    End If

End Function


Private Function APS_ContainsScore( _
    ByVal query As String, _
    ByVal candidate As String, _
    ByVal baseScore As Double) As Double

    Dim position As Long

    If Len(query) = 0 Then Exit Function

    position = _
        InStr( _
            1, _
            candidate, _
            query, _
            vbTextCompare)

    If position > 0 Then

        APS_ContainsScore = _
            baseScore - _
            ((position - 1) * 0.5)

    End If

End Function


Private Function APS_TokenCoverageScore( _
    ByVal query As String, _
    ByVal candidate As String) As Double

    Dim tokens() As String
    Dim token As Variant

    Dim totalCount As Long
    Dim hitCount As Long

    tokens = Split(query, " ")

    For Each token In tokens

        If Len(CStr(token)) > 0 Then

            totalCount = totalCount + 1

            If InStr( _
                1, _
                candidate, _
                CStr(token), _
                vbTextCompare) > 0 Then

                hitCount = hitCount + 1

            End If

        End If

    Next token

    If totalCount > 0 Then

        APS_TokenCoverageScore = _
            CDbl(hitCount) / _
            CDbl(totalCount)

    End If

End Function


Private Function APS_BestTokenSimilarity( _
    ByVal query As String, _
    ByVal candidate As String) As Double

    Dim qTokens() As String
    Dim cTokens() As String

    Dim i As Long
    Dim j As Long

    Dim similarity As Double
    Dim bestForToken As Double

    Dim totalSimilarity As Double
    Dim tokenCount As Long

    qTokens = Split(query, " ")
    cTokens = Split(candidate, " ")

    For i = LBound(qTokens) To UBound(qTokens)

        If Len(qTokens(i)) > 0 Then

            bestForToken = 0

            For j = LBound(cTokens) To UBound(cTokens)

                If Len(cTokens(j)) > 0 Then

                    similarity = _
                        APS_StringSimilarity( _
                            qTokens(i), _
                            cTokens(j))

                    If similarity > bestForToken Then
                        bestForToken = similarity
                    End If

                End If

            Next j

            totalSimilarity = _
                totalSimilarity + _
                bestForToken

            tokenCount = tokenCount + 1

        End If

    Next i

    If tokenCount > 0 Then

        APS_BestTokenSimilarity = _
            totalSimilarity / _
            tokenCount

    End If

End Function


Private Function APS_StringSimilarity( _
    ByVal a As String, _
    ByVal b As String) As Double

    Dim distance As Long
    Dim maximumLength As Long

    If Len(a) = 0 And Len(b) = 0 Then

        APS_StringSimilarity = 1
        Exit Function

    End If

    If Len(a) = 0 Or Len(b) = 0 Then Exit Function

    If Len(a) > Len(b) Then
        maximumLength = Len(a)
    Else
        maximumLength = Len(b)
    End If

    distance = _
        APS_LevenshteinDistance( _
            a, _
            b)

    APS_StringSimilarity = _
        1 - _
        (CDbl(distance) / CDbl(maximumLength))

End Function


Private Function APS_LevenshteinDistance( _
    ByVal source As String, _
    ByVal target As String) As Long

    Dim sourceLength As Long
    Dim targetLength As Long

    Dim previousRow() As Long
    Dim currentRow() As Long

    Dim i As Long
    Dim j As Long

    Dim charCost As Long

    Dim deleteCost As Long
    Dim insertCost As Long
    Dim substituteCost As Long

    sourceLength = Len(source)
    targetLength = Len(target)

    If sourceLength = 0 Then

        APS_LevenshteinDistance = targetLength
        Exit Function

    End If

    If targetLength = 0 Then

        APS_LevenshteinDistance = sourceLength
        Exit Function

    End If

    ReDim previousRow(0 To targetLength)
    ReDim currentRow(0 To targetLength)

    For j = 0 To targetLength
        previousRow(j) = j
    Next j

    For i = 1 To sourceLength

        currentRow(0) = i

        For j = 1 To targetLength

            If Mid$(source, i, 1) = _
               Mid$(target, j, 1) Then

                charCost = 0

            Else

                charCost = 1

            End If

            deleteCost = previousRow(j) + 1
            insertCost = currentRow(j - 1) + 1

            substituteCost = _
                previousRow(j - 1) + _
                charCost

            currentRow(j) = _
                APS_MinimumOfThree( _
                    deleteCost, _
                    insertCost, _
                    substituteCost)

        Next j

        For j = 0 To targetLength
            previousRow(j) = currentRow(j)
        Next j

    Next i

    APS_LevenshteinDistance = _
        previousRow(targetLength)

End Function


Private Function APS_MinimumOfThree( _
    ByVal a As Long, _
    ByVal b As Long, _
    ByVal c As Long) As Long

    Dim result As Long

    result = a

    If b < result Then result = b
    If c < result Then result = c

    APS_MinimumOfThree = result

End Function


Private Sub APS_InsertRankedResult( _
    ByVal newScore As Double, _
    ByVal newIndex As Long, _
    ByRef scores() As Double, _
    ByRef indices() As Long)

    Dim position As Long
    Dim movePosition As Long

    For position = _
        LBound(scores) _
        To UBound(scores)

        If newScore > scores(position) Then

            For movePosition = _
                UBound(scores) _
                To position + 1 _
                Step -1

                scores(movePosition) = _
                    scores(movePosition - 1)

                indices(movePosition) = _
                    indices(movePosition - 1)

            Next movePosition

            scores(position) = newScore
            indices(position) = newIndex

            Exit Sub

        End If

    Next position

End Sub


'===========================================================
' NORMAL DYNAMIC PREVIEW
'===========================================================

Public Sub APS_PreviewBestResult( _
    Optional ByVal zoomToPart As Boolean = False)

    Dim componentIndex As Long

    Dim activeModel As SldWorks.ModelDoc2
    Dim swComp As SldWorks.Component2

    Dim success As Boolean
    Dim stepName As String

    If APS_SelectionBusy Then Exit Sub
    If Not APS_IsIndexedAssemblyActive() Then Exit Sub
    If APS_ComponentCount <= 0 Then Exit Sub

    componentIndex = APS_ResultMap(0)

    If componentIndex < 0 Or _
       componentIndex >= APS_ComponentCount Then Exit Sub

    If componentIndex = APS_PreviewComponentIndex Then

        If zoomToPart Then
            APS_ZoomToCurrentSelection
        End If

        Exit Sub

    End If

    APS_SelectionBusy = True

    On Error GoTo PreviewError

    Set activeModel = APS_swApp.ActiveDoc
    Set swComp = APS_Components(componentIndex)

    If swComp Is Nothing Then GoTo Finished

    activeModel.ClearSelection2 True

    stepName = "Component2.Select4"

    success = _
        swComp.Select4( _
            False, _
            Nothing, _
            False)

    APS_Log _
        "PREVIEW", _
        "Select=" & _
        APS_BaseName(componentIndex) & _
        " | Success=" & _
        CStr(success)

    If success Then

        APS_PreviewComponentIndex = componentIndex

        If zoomToPart Then

            stepName = "ViewZoomToSelection"
            activeModel.ViewZoomToSelection

        Else

            activeModel.GraphicsRedraw2

        End If

    End If

Finished:

    APS_SelectionBusy = False
    Exit Sub

PreviewError:

    APS_LogError _
        "APS_PreviewBestResult", _
        stepName, _
        Err.Number, _
        Err.Description, _
        Err.Source

    APS_SelectionBusy = False

End Sub


'===========================================================
' SELECT CURRENT LIST RESULTS IN SOLIDWORKS
'
' Returns number of components that Select4 actually
' reported as selected.
'===========================================================

Private Function APS_SelectListResultsInSolidWorks( _
    ByVal frm As Object, _
    Optional ByVal zoomAfterSelect As Boolean = False, _
    Optional ByVal updateStatus As Boolean = True) As Long

    Dim activeModel As SldWorks.ModelDoc2
    Dim swComp As SldWorks.Component2

    Dim i As Long
    Dim componentIndex As Long

    Dim selectedCount As Long
    Dim firstSelection As Boolean
    Dim success As Boolean
    Dim singleComponentIndex As Long

    Dim stepName As String

    APS_SelectListResultsInSolidWorks = 0

    If APS_UpdatingResults Then Exit Function
    If APS_SelectionBusy Then Exit Function
    If Not APS_IsIndexedAssemblyActive() Then Exit Function

    APS_SelectionBusy = True

    On Error GoTo SelectionError

    Set activeModel = APS_swApp.ActiveDoc

    activeModel.ClearSelection2 True

    firstSelection = True
    selectedCount = 0
    singleComponentIndex = -1

    For i = 0 To frm.lstResults.ListCount - 1

        If frm.lstResults.Selected(i) Then

            componentIndex = APS_ResultMap(i)

            If componentIndex >= 0 And _
               componentIndex < APS_ComponentCount Then

                Set swComp = _
                    APS_Components(componentIndex)

                If Not swComp Is Nothing Then

                    stepName = _
                        "Select4 " & _
                        APS_BaseName(componentIndex)

                    success = _
                        swComp.Select4( _
                            Not firstSelection, _
                            Nothing, _
                            False)

                    APS_Log _
                        "SELECTION", _
                        APS_BaseName(componentIndex) & _
                        " | Select4=" & _
                        CStr(success)

                    If success Then

                        selectedCount = selectedCount + 1
                        singleComponentIndex = componentIndex
                        firstSelection = False

                    End If

                End If

            End If

        End If

    Next i

    If selectedCount = 1 Then
        APS_PreviewComponentIndex = singleComponentIndex
    Else
        APS_PreviewComponentIndex = -1
    End If

    If selectedCount > 0 Then

        If zoomAfterSelect Then

            stepName = "ViewZoomToSelection"
            activeModel.ViewZoomToSelection

        Else

            activeModel.GraphicsRedraw2

        End If

    End If

    If updateStatus Then

        If selectedCount = 0 Then

            frm.lblStatus.Caption = _
                "No components selected"

        ElseIf selectedCount = 1 Then

            frm.lblStatus.Caption = _
                "1 component selected"

        Else

            frm.lblStatus.Caption = _
                CStr(selectedCount) & _
                " components selected"

        End If

    End If

    APS_SelectListResultsInSolidWorks = selectedCount

Finished:

    APS_SelectionBusy = False
    Exit Function

SelectionError:

    APS_LogError _
        "APS_SelectListResultsInSolidWorks", _
        stepName, _
        Err.Number, _
        Err.Description, _
        Err.Source

    APS_SelectionBusy = False

End Function


Public Sub APS_SyncListSelectionToSolidWorks( _
    ByVal frm As Object, _
    Optional ByVal zoomAfterSelect As Boolean = False)

    Dim selectedCount As Long

    selectedCount = _
        APS_SelectListResultsInSolidWorks( _
            frm, _
            zoomAfterSelect, _
            True)

End Sub


Public Function APS_CountSelectedResults( _
    ByVal frm As Object) As Long

    Dim i As Long
    Dim selectedCount As Long

    For i = 0 To frm.lstResults.ListCount - 1

        If frm.lstResults.Selected(i) Then
            selectedCount = selectedCount + 1
        End If

    Next i

    APS_CountSelectedResults = selectedCount

End Function


Public Sub APS_ZoomToCurrentSelection()

    Dim activeModel As SldWorks.ModelDoc2

    If APS_SelectionBusy Then Exit Sub
    If Not APS_IsIndexedAssemblyActive() Then Exit Sub

    On Error GoTo ZoomError

    Set activeModel = APS_swApp.ActiveDoc

    activeModel.ViewZoomToSelection

    Exit Sub

ZoomError:

    APS_LogError _
        "APS_ZoomToCurrentSelection", _
        "ViewZoomToSelection", _
        Err.Number, _
        Err.Description, _
        Err.Source

End Sub


'===========================================================
' SELECTION SIGNATURE
'===========================================================

Private Function APS_GetSelectionSignature( _
    ByVal frm As Object) As String

    Dim i As Long
    Dim componentIndex As Long

    Dim result As String

    For i = 0 To frm.lstResults.ListCount - 1

        If frm.lstResults.Selected(i) Then

            componentIndex = APS_ResultMap(i)

            If componentIndex >= 0 And _
               componentIndex < APS_ComponentCount Then

                result = _
                    result & _
                    "|" & _
                    CStr(componentIndex)

            End If

        End If

    Next i

    APS_GetSelectionSignature = result

End Function


'===========================================================
' CURRENT LIST SELECTION DISPATCHER
'===========================================================

Public Sub APS_ApplyCurrentListSelection( _
    ByVal frm As Object, _
    Optional ByVal zoomAfterSelect As Boolean = True)

    If APS_UpdatingResults Then Exit Sub
    If APS_DynamicIsolateBusy Then Exit Sub
    If APS_IsolationBusy Then Exit Sub

    If APS_FastIsolateActive Then

        APS_DynamicSwitchIsolate _
            frm, _
            zoomAfterSelect

    Else

        APS_SyncListSelectionToSolidWorks _
            frm, _
            zoomAfterSelect

    End If

End Sub


 '===========================================================
' FAST ISOLATE - LOW LEVEL VISIBILITY HELPERS
'===========================================================

Private Function APS_GetComponentVisibilitySafe( _
    ByVal swComp As SldWorks.Component2) As Long

    APS_GetComponentVisibilitySafe = _
        APS_VISIBILITY_UNKNOWN

    If swComp Is Nothing Then Exit Function

    On Error Resume Next
    Err.Clear

    APS_GetComponentVisibilitySafe = _
        swComp.Visible

    If Err.Number <> 0 Then

        APS_GetComponentVisibilitySafe = _
            APS_VISIBILITY_UNKNOWN

        Err.Clear

    End If

    On Error GoTo 0

End Function


Private Function APS_SetComponentVisibilitySafe( _
    ByVal swComp As SldWorks.Component2, _
    ByVal visibilityState As Long) As Boolean

    APS_SetComponentVisibilitySafe = False

    If swComp Is Nothing Then Exit Function

    On Error Resume Next
    Err.Clear

    swComp.Visible = visibilityState

    If Err.Number = 0 Then
        APS_SetComponentVisibilitySafe = True
    Else
        Err.Clear
    End If

    On Error GoTo 0

End Function


Private Sub APS_SetFeatureTreeUpdates( _
    ByVal enabled As Boolean)

    Dim swFeatureMgr As SldWorks.FeatureManager

    On Error Resume Next

    If APS_swModel Is Nothing Then Exit Sub

    Set swFeatureMgr = APS_swModel.FeatureManager

    If swFeatureMgr Is Nothing Then Exit Sub

    If enabled Then

        swFeatureMgr.EnableFeatureTree = True
        swFeatureMgr.EnableFeatureTreeWindow = True
        swFeatureMgr.UpdateFeatureTree

    Else

        swFeatureMgr.EnableFeatureTreeWindow = False
        swFeatureMgr.EnableFeatureTree = False

    End If

    On Error GoTo 0

End Sub



Private Sub APS_SetGraphicsUpdates( _
    ByVal enabled As Boolean)

    Dim swView As SldWorks.ModelView

    On Error Resume Next

    If APS_swModel Is Nothing Then Exit Sub

    Set swView = APS_swModel.ActiveView

    If swView Is Nothing Then Exit Sub

    swView.EnableGraphicsUpdate = enabled

    On Error GoTo 0

End Sub


'===========================================================
' BULK COMPONENT SELECTION
'
' Uses IModelDocExtension.MultiSelect2 so hundreds of
' components are selected in one API call instead of one
' Select4 call per component.
'===========================================================

Private Function APS_BulkSelectComponents( _
    ByRef components() As SldWorks.Component2) As Long

    Dim swExt As SldWorks.ModelDocExtension

    APS_BulkSelectComponents = 0

    On Error GoTo BulkSelectError

    If APS_swModel Is Nothing Then Exit Function

    Set swExt = APS_swModel.Extension

    If swExt Is Nothing Then Exit Function

    APS_swModel.ClearSelection2 True

    APS_BulkSelectComponents = _
        swExt.MultiSelect2( _
            components, _
            False, _
            Nothing)

    Exit Function

BulkSelectError:

    APS_LogError _
        "APS_BulkSelectComponents", _
        "MultiSelect2", _
        Err.Number, _
        Err.Description, _
        Err.Source

End Function


'===========================================================
' BULK HIDE NON-SELECTED PART INSTANCES
'
' This is the key R10 optimization:
'
'   R9:
'       437 x Component2.Visible = Hidden
'
'   R10:
'       1 x MultiSelect2(array of components)
'       1 x IModelDoc2.HideComponent2
'
'===========================================================

Private Function APS_BulkHideUnselectedParts( _
    ByRef desiredVisible() As Boolean, _
    ByRef targetCount As Long, _
    ByRef selectedCount As Long) As Boolean

    Dim targets() As SldWorks.Component2

    Dim i As Long
    Dim idx As Long

    targetCount = 0
    selectedCount = 0

    APS_BulkHideUnselectedParts = False

    If APS_ComponentCount <= 0 Then Exit Function

    'Count only currently visible non-selected part instances.
    For i = 0 To APS_ComponentCount - 1

        If Not desiredVisible(i) Then

            If APS_GetComponentVisibilitySafe( _
                APS_Components(i)) <> _
                APS_COMPONENT_HIDDEN Then

                targetCount = targetCount + 1

            End If

        End If

    Next i

    If targetCount = 0 Then

        APS_BulkHideUnselectedParts = True
        Exit Function

    End If

    ReDim targets(0 To targetCount - 1)

    idx = 0

    For i = 0 To APS_ComponentCount - 1

        If Not desiredVisible(i) Then

            If APS_GetComponentVisibilitySafe( _
                APS_Components(i)) <> _
                APS_COMPONENT_HIDDEN Then

                Set targets(idx) = APS_Components(i)

                idx = idx + 1

            End If

        End If

    Next i

    selectedCount = _
        APS_BulkSelectComponents( _
            targets)

    APS_Log _
        "FAST_ISOLATE", _
        "Bulk hide selection | Target=" & _
        CStr(targetCount) & _
        " | Selected=" & _
        CStr(selectedCount)

    If selectedCount <= 0 Then Exit Function

    APS_swModel.HideComponent2

    APS_swModel.ClearSelection2 True

    APS_BulkHideUnselectedParts = _
        (selectedCount = targetCount)

End Function


'===========================================================
' BULK RESTORE PART VISIBILITY
'
' At exit:
'   - one ShowComponent2 call for parts that were visible
'   - one HideComponent2 call for parts that were hidden
'
' Subassembly-parent visibility is restored separately; the
' number of parent components is typically very small.
'===========================================================

Private Function APS_BulkRestorePartVisibility( _
    ByRef shownCount As Long, _
    ByRef hiddenCount As Long) As Boolean

    Dim showTargets() As SldWorks.Component2
    Dim hideTargets() As SldWorks.Component2

    Dim i As Long
    Dim showTargetCount As Long
    Dim hideTargetCount As Long

    Dim showIdx As Long
    Dim hideIdx As Long

    Dim selectedCount As Long
    Dim failed As Boolean

    APS_BulkRestorePartVisibility = False

    If APS_AllCount <= 0 Then Exit Function

    For i = 0 To APS_AllCount - 1

        If APS_AllIsPart(i) Then

            Select Case APS_OriginalVisibility(i)

                Case APS_COMPONENT_VISIBLE
                    showTargetCount = showTargetCount + 1

                Case APS_COMPONENT_HIDDEN
                    hideTargetCount = hideTargetCount + 1

            End Select

        End If

    Next i

    If showTargetCount > 0 Then
        ReDim showTargets(0 To showTargetCount - 1)
    End If

    If hideTargetCount > 0 Then
        ReDim hideTargets(0 To hideTargetCount - 1)
    End If

    For i = 0 To APS_AllCount - 1

        If APS_AllIsPart(i) Then

            Select Case APS_OriginalVisibility(i)

                Case APS_COMPONENT_VISIBLE

                    Set showTargets(showIdx) = _
                        APS_AllComponents(i)

                    showIdx = showIdx + 1

                Case APS_COMPONENT_HIDDEN

                    Set hideTargets(hideIdx) = _
                        APS_AllComponents(i)

                    hideIdx = hideIdx + 1

            End Select

        End If

    Next i

    If showTargetCount > 0 Then

        selectedCount = _
            APS_BulkSelectComponents( _
                showTargets)

        APS_Log _
            "FAST_ISOLATE_EXIT", _
            "Bulk show | Target=" & _
            CStr(showTargetCount) & _
            " | Selected=" & _
            CStr(selectedCount)

        If selectedCount > 0 Then
            APS_swModel.ShowComponent2
            shownCount = selectedCount
        End If

        If selectedCount <> showTargetCount Then
            failed = True
        End If

    End If

    If hideTargetCount > 0 Then

        selectedCount = _
            APS_BulkSelectComponents( _
                hideTargets)

        APS_Log _
            "FAST_ISOLATE_EXIT", _
            "Bulk hide restore | Target=" & _
            CStr(hideTargetCount) & _
            " | Selected=" & _
            CStr(selectedCount)

        If selectedCount > 0 Then
            APS_swModel.HideComponent2
            hiddenCount = selectedCount
        End If

        If selectedCount <> hideTargetCount Then
            failed = True
        End If

    End If

    APS_swModel.ClearSelection2 True

    APS_BulkRestorePartVisibility = Not failed

End Function


Private Function APS_TakeFastVisibilitySnapshot() As Boolean

    Dim i As Long
    Dim state As Long
    Dim unknownCount As Long

    APS_TakeFastVisibilitySnapshot = False
    APS_FastSnapshotValid = False

    If APS_AllCount <= 0 Then Exit Function

    ReDim APS_OriginalVisibility(0 To APS_AllCount - 1)

    For i = 0 To APS_AllCount - 1

        state = _
            APS_GetComponentVisibilitySafe( _
                APS_AllComponents(i))

        APS_OriginalVisibility(i) = state

        If state = APS_VISIBILITY_UNKNOWN Then
            unknownCount = unknownCount + 1
        End If

    Next i

    APS_FastSnapshotValid = True
    APS_TakeFastVisibilitySnapshot = True

    APS_Log _
        "FAST_ISOLATE", _
        "Visibility snapshot captured | Components=" & _
        CStr(APS_AllCount) & _
        " | Unknown=" & CStr(unknownCount)

End Function


Private Function APS_RestoreFastVisibilitySnapshot( _
    ByVal operationName As String) As Boolean

    Dim i As Long
    Dim state As Long

    Dim shownCount As Long
    Dim hiddenCount As Long

    Dim parentRestoredCount As Long
    Dim parentFailedCount As Long

    Dim bulkSuccess As Boolean

    Dim started As Double
    Dim elapsed As Double

    APS_RestoreFastVisibilitySnapshot = False

    If Not APS_FastSnapshotValid Then

        APS_Log _
            operationName, _
            "No Fast Isolate visibility snapshot exists"

        APS_RestoreFastVisibilitySnapshot = True

        Exit Function

    End If

    If APS_AllCount <= 0 Then Exit Function

    started = Timer

    APS_SetFeatureTreeUpdates False
    APS_SetGraphicsUpdates False

    On Error GoTo RestoreError

    '-------------------------------------------------------
    ' BULK RESTORE ALL PART INSTANCES
    '-------------------------------------------------------

    bulkSuccess = _
        APS_BulkRestorePartVisibility( _
            shownCount, _
            hiddenCount)

    '-------------------------------------------------------
    ' RESTORE SUBASSEMBLY-PARENT VISIBILITY
    '
    'There are usually very few of these compared with the
    'hundreds/thousands of leaf parts, so individual writes
    'are inexpensive here.
    '-------------------------------------------------------

    For i = 0 To APS_AllCount - 1

        If Not APS_AllIsPart(i) Then

            state = APS_OriginalVisibility(i)

            If state = APS_COMPONENT_HIDDEN Or _
               state = APS_COMPONENT_VISIBLE Then

                If APS_SetComponentVisibilitySafe( _
                    APS_AllComponents(i), _
                    state) Then

                    parentRestoredCount = _
                        parentRestoredCount + 1

                Else

                    parentFailedCount = _
                        parentFailedCount + 1

                End If

            End If

        End If

    Next i

    APS_SetGraphicsUpdates True
    APS_SetFeatureTreeUpdates True

    APS_swModel.ClearSelection2 True
    APS_swModel.GraphicsRedraw2

    elapsed = Timer - started

    If elapsed < 0 Then
        elapsed = elapsed + 86400
    End If

    APS_Log _
        operationName, _
        "BULK visibility restored" & _
        " | PartsShown=" & CStr(shownCount) & _
        " | PartsHidden=" & CStr(hiddenCount) & _
        " | Parents=" & CStr(parentRestoredCount) & _
        " | ParentFailed=" & CStr(parentFailedCount) & _
        " | Time=" & _
        Format$(elapsed, "0.000") & " sec"

    APS_RestoreFastVisibilitySnapshot = _
        bulkSuccess And _
        (parentFailedCount = 0)

    Exit Function

RestoreError:

    APS_SetGraphicsUpdates True
    APS_SetFeatureTreeUpdates True

    On Error Resume Next
    APS_swModel.ClearSelection2 True
    APS_swModel.GraphicsRedraw2
    On Error GoTo 0

    APS_LogError _
        "APS_RestoreFastVisibilitySnapshot", _
        operationName, _
        Err.Number, _
        Err.Description, _
        Err.Source

End Function

Private Sub APS_ShowAncestorChain( _
    ByVal swComp As SldWorks.Component2)

    Dim swParent As SldWorks.Component2
    Dim depth As Long

    On Error Resume Next

    Set swParent = swComp.GetParent

    On Error GoTo 0

    For depth = 1 To APS_MAX_PARENT_DEPTH

        If swParent Is Nothing Then Exit For

        APS_SetComponentVisibilitySafe _
            swParent, _
            APS_COMPONENT_VISIBLE

        Set swComp = swParent

        On Error Resume Next

        Set swParent = swComp.GetParent

        On Error GoTo 0

    Next depth

End Sub


Private Sub APS_BuildSelectedPartMask( _
    ByVal frm As Object, _
    ByRef desiredVisible() As Boolean, _
    ByRef requestedCount As Long)

    Dim i As Long
    Dim componentIndex As Long

    requestedCount = 0

    If APS_ComponentCount <= 0 Then Exit Sub

    ReDim desiredVisible(0 To APS_ComponentCount - 1)

    For i = 0 To frm.lstResults.ListCount - 1

        If frm.lstResults.Selected(i) Then

            componentIndex = APS_ResultMap(i)

            If componentIndex >= 0 And _
               componentIndex < APS_ComponentCount Then

                If Not desiredVisible(componentIndex) Then

                    desiredVisible(componentIndex) = True
                    requestedCount = requestedCount + 1

                End If

            End If

        End If

    Next i

End Sub


Private Function APS_EnterFastVisibilityMode( _
    ByVal frm As Object, _
    ByRef requestedCount As Long) As Boolean

    Dim desiredVisible() As Boolean

    Dim i As Long

    Dim bulkTargetCount As Long
    Dim bulkSelectedCount As Long

    Dim shownCount As Long
    Dim failedCount As Long

    Dim bulkHideSuccess As Boolean

    Dim started As Double
    Dim elapsed As Double

    APS_EnterFastVisibilityMode = False

    APS_BuildSelectedPartMask _
        frm, _
        desiredVisible, _
        requestedCount

    If requestedCount <= 0 Then Exit Function

    If Not APS_TakeFastVisibilitySnapshot() Then
        Exit Function
    End If

    If APS_ComponentCount <= 0 Then Exit Function

    ReDim APS_FastCurrentVisiblePart( _
        0 To APS_ComponentCount - 1)

    started = Timer

    APS_SetFeatureTreeUpdates False
    APS_SetGraphicsUpdates False

    On Error GoTo EnterError

    '-------------------------------------------------------
    ' BULK HIDE EVERY NON-SELECTED VISIBLE PART
    '
    'This replaces hundreds/thousands of individual
    'Component2.Visible writes with one MultiSelect2 call
    'and one HideComponent2 call.
    '-------------------------------------------------------

    bulkHideSuccess = _
        APS_BulkHideUnselectedParts( _
            desiredVisible, _
            bulkTargetCount, _
            bulkSelectedCount)

    If Not bulkHideSuccess Then

        APS_Log _
            "FAST_ISOLATE", _
            "WARNING: bulk hide selected " & _
            CStr(bulkSelectedCount) & _
            " of " & _
            CStr(bulkTargetCount)

        failedCount = _
            Abs(bulkTargetCount - bulkSelectedCount)

    End If

    'Track current fast-isolate mask.
    For i = 0 To APS_ComponentCount - 1
        APS_FastCurrentVisiblePart(i) = desiredVisible(i)
    Next i

    'Selected parts are only a very small set, so individual
    'show calls are inexpensive and safely handle a part that
    'was originally hidden.
    For i = 0 To APS_ComponentCount - 1

        If desiredVisible(i) Then

            APS_ShowAncestorChain _
                APS_Components(i)

            If APS_SetComponentVisibilitySafe( _
                APS_Components(i), _
                APS_COMPONENT_VISIBLE) Then

                shownCount = shownCount + 1

            Else

                failedCount = failedCount + 1

            End If

        End If

    Next i

    APS_swModel.ClearSelection2 True

    APS_SetGraphicsUpdates True
    APS_SetFeatureTreeUpdates True

    APS_swModel.GraphicsRedraw2

    elapsed = Timer - started

    If elapsed < 0 Then
        elapsed = elapsed + 86400
    End If

    APS_Log _
        "FAST_ISOLATE", _
        "ENTER BULK visibility layer" & _
        " | BulkHideTarget=" & _
        CStr(bulkTargetCount) & _
        " | BulkSelected=" & _
        CStr(bulkSelectedCount) & _
        " | SelectedShown=" & _
        CStr(shownCount) & _
        " | Failed=" & _
        CStr(failedCount) & _
        " | Time=" & _
        Format$(elapsed, "0.000") & " sec"

    APS_EnterFastVisibilityMode = _
        (failedCount = 0)

    Exit Function

EnterError:

    APS_SetGraphicsUpdates True
    APS_SetFeatureTreeUpdates True

    On Error Resume Next
    APS_swModel.ClearSelection2 True
    APS_swModel.GraphicsRedraw2
    On Error GoTo 0

    APS_LogError _
        "APS_EnterFastVisibilityMode", _
        "Enter bulk visibility layer", _
        Err.Number, _
        Err.Description, _
        Err.Source

End Function

Private Function APS_SwitchFastVisibility( _
    ByVal frm As Object, _
    ByRef requestedCount As Long, _
    ByRef hideCalls As Long, _
    ByRef showCalls As Long) As Boolean

    Dim desiredVisible() As Boolean
    Dim i As Long
    Dim failedCount As Long

    APS_SwitchFastVisibility = False

    APS_BuildSelectedPartMask _
        frm, _
        desiredVisible, _
        requestedCount

    If requestedCount <= 0 Then Exit Function
    If Not APS_FastSnapshotValid Then Exit Function

    For i = 0 To APS_ComponentCount - 1

        If APS_FastCurrentVisiblePart(i) And _
           Not desiredVisible(i) Then

            If APS_SetComponentVisibilitySafe( _
                APS_Components(i), _
                APS_COMPONENT_HIDDEN) Then

                hideCalls = hideCalls + 1

            Else

                failedCount = failedCount + 1

            End If

            APS_FastCurrentVisiblePart(i) = False

        End If

    Next i

    For i = 0 To APS_ComponentCount - 1

        If desiredVisible(i) And _
           Not APS_FastCurrentVisiblePart(i) Then

            APS_ShowAncestorChain _
                APS_Components(i)

            If APS_SetComponentVisibilitySafe( _
                APS_Components(i), _
                APS_COMPONENT_VISIBLE) Then

                showCalls = showCalls + 1

            Else

                failedCount = failedCount + 1

            End If

            APS_FastCurrentVisiblePart(i) = True

        End If

    Next i

    APS_SwitchFastVisibility = _
        (failedCount = 0)

End Function


'===========================================================
' FAST ISOLATE - INITIAL ENTRY
'===========================================================

Public Sub APS_IsolateSelected( _
    ByVal frm As Object, _
    Optional ByVal zoomAfterIsolate As Boolean = True)

    Dim activeModel As SldWorks.ModelDoc2

    Dim requestedCount As Long
    Dim selectedInSW As Long

    Dim currentSignature As String
    Dim fastEnterSuccess As Boolean

    Dim stepName As String

    Dim started As Double
    Dim elapsed As Double

    If APS_IsolationBusy Then Exit Sub
    If APS_DynamicIsolateBusy Then Exit Sub

    If Not APS_IsIndexedAssemblyActive() Then

        frm.lblStatus.Caption = _
            "Active assembly changed - click Refresh"

        Exit Sub

    End If

    requestedCount = APS_CountSelectedResults(frm)

    If requestedCount <= 0 Then

        frm.lblStatus.Caption = _
            "Select one or more components first"

        Exit Sub

    End If

    currentSignature = APS_GetSelectionSignature(frm)

    If Len(currentSignature) = 0 Then Exit Sub

    If APS_FastIsolateActive Then

        APS_DynamicSwitchIsolate _
            frm, _
            zoomAfterIsolate

        Exit Sub

    End If

    APS_IsolationBusy = True
    APS_DisableWheelSubclass

    On Error GoTo IsolateError

    started = Timer

    Set activeModel = APS_swApp.ActiveDoc

    stepName = "Create Fast Isolate visibility layer"
    APS_SetStep "FAST_ISOLATE", stepName

    fastEnterSuccess = _
        APS_EnterFastVisibilityMode( _
            frm, _
            requestedCount)

    If Not fastEnterSuccess Then

        frm.lblStatus.Caption = _
            "Fast Isolate could not create visibility layer"

        If APS_FastSnapshotValid Then

            APS_RestoreFastVisibilitySnapshot _
                "FAST_ISOLATE_ROLLBACK"

        End If

        APS_FastSnapshotValid = False

        GoTo Finished

    End If

    APS_FastIsolateActive = True

    APS_LastIsolateSelectionSignature = _
        currentSignature

    stepName = "Select visible isolated components"

    selectedInSW = _
        APS_SelectListResultsInSolidWorks( _
            frm, _
            False, _
            False)

    If selectedInSW <> requestedCount Then

        APS_Log _
            "FAST_ISOLATE", _
            "WARNING selection mismatch | Requested=" & _
            CStr(requestedCount) & _
            " | Selected=" & CStr(selectedInSW)

    End If

    If zoomAfterIsolate And _
       selectedInSW > 0 Then

        stepName = "ViewZoomToSelection"
        activeModel.ViewZoomToSelection

    Else

        activeModel.GraphicsRedraw2

    End If

    If requestedCount = 1 Then

        frm.lblStatus.Caption = _
            "1 component fast-isolated"

    Else

        frm.lblStatus.Caption = _
            CStr(requestedCount) & _
            " components fast-isolated"

    End If

    elapsed = Timer - started

    If elapsed < 0 Then
        elapsed = elapsed + 86400
    End If

    APS_Log _
        "FAST_ISOLATE", _
        "MODE ON | Signature=" & _
        currentSignature & _
        " | Total time=" & _
        Format$(elapsed, "0.000") & " sec"

Finished:

    APS_IsolationBusy = False
    Exit Sub

IsolateError:

    APS_SetFeatureTreeUpdates True

    APS_LogError _
        "APS_IsolateSelected", _
        stepName, _
        Err.Number, _
        Err.Description, _
        Err.Source

    If APS_FastSnapshotValid Then

        APS_RestoreFastVisibilitySnapshot _
            "FAST_ISOLATE_ERROR_ROLLBACK"

    End If

    APS_FastIsolateActive = False
    APS_FastSnapshotValid = False
    APS_LastIsolateSelectionSignature = ""

    APS_IsolationBusy = False

    frm.lblStatus.Caption = _
        "Fast Isolate error at: " & _
        stepName

End Sub


'===========================================================
' FAST ISOLATE - DYNAMIC SWITCH
'===========================================================

Public Sub APS_DynamicSwitchIsolate( _
    ByVal frm As Object, _
    Optional ByVal zoomAfterSwitch As Boolean = True)

    Dim activeModel As SldWorks.ModelDoc2

    Dim requestedCount As Long
    Dim selectedInSW As Long

    Dim currentSignature As String

    Dim hideCalls As Long
    Dim showCalls As Long

    Dim visibilitySuccess As Boolean

    Dim started As Double
    Dim elapsed As Double

    Dim stepName As String

    If APS_DynamicIsolateBusy Then Exit Sub
    If APS_IsolationBusy Then Exit Sub
    If Not APS_FastIsolateActive Then Exit Sub
    If Not APS_IsIndexedAssemblyActive() Then Exit Sub

    requestedCount = APS_CountSelectedResults(frm)

    If requestedCount <= 0 Then Exit Sub

    currentSignature = APS_GetSelectionSignature(frm)

    If Len(currentSignature) = 0 Then Exit Sub

    If currentSignature = _
       APS_LastIsolateSelectionSignature Then

        APS_Log _
            "FAST_SWITCH", _
            "Signature unchanged - select/zoom only"

        APS_SyncListSelectionToSolidWorks _
            frm, _
            zoomAfterSwitch

        Exit Sub

    End If

    APS_DynamicIsolateBusy = True
    APS_DisableWheelSubclass

    On Error GoTo DynamicError

    started = Timer

    Set activeModel = APS_swApp.ActiveDoc

    APS_Log _
        "FAST_SWITCH", _
        "START | Old=" & _
        APS_LastIsolateSelectionSignature & _
        " | New=" & currentSignature

    stepName = "Apply visibility delta"

    visibilitySuccess = _
        APS_SwitchFastVisibility( _
            frm, _
            requestedCount, _
            hideCalls, _
            showCalls)

    If Not visibilitySuccess Then

        APS_Log _
            "FAST_SWITCH", _
            "WARNING: one or more visibility changes failed"

    End If

    APS_LastIsolateSelectionSignature = _
        currentSignature

    stepName = "Select new visible set"

    selectedInSW = _
        APS_SelectListResultsInSolidWorks( _
            frm, _
            False, _
            False)

    If zoomAfterSwitch And _
       selectedInSW > 0 Then

        stepName = "ViewZoomToSelection"
        activeModel.ViewZoomToSelection

    Else

        activeModel.GraphicsRedraw2

    End If

    If requestedCount = 1 Then

        frm.lblStatus.Caption = _
            "1 component fast-isolated"

    Else

        frm.lblStatus.Caption = _
            CStr(requestedCount) & _
            " components fast-isolated"

    End If

    elapsed = Timer - started

    If elapsed < 0 Then
        elapsed = elapsed + 86400
    End If

    APS_Log _
        "FAST_SWITCH", _
        "COMPLETE | HideCalls=" & _
        CStr(hideCalls) & _
        " | ShowCalls=" & CStr(showCalls) & _
        " | Selected=" & CStr(selectedInSW) & _
        " | Time=" & _
        Format$(elapsed, "0.0000") & " sec"

Finished:

    APS_DynamicIsolateBusy = False
    Exit Sub

DynamicError:

    APS_LogError _
        "APS_DynamicSwitchIsolate", _
        stepName, _
        Err.Number, _
        Err.Description, _
        Err.Source

    APS_PrintDiagnostics

    APS_DynamicIsolateBusy = False

    frm.lblStatus.Caption = _
        "Fast switch error at: " & _
        stepName

End Sub


'===========================================================
' FAST ISOLATE - EXIT
'===========================================================

Public Sub APS_ExitIsolate( _
    ByVal frm As Object)

    Dim success As Boolean

    If APS_IsolationBusy Then Exit Sub
    If APS_DynamicIsolateBusy Then Exit Sub

    APS_IsolationBusy = True
    APS_DisableWheelSubclass

    APS_Log _
        "FAST_ISOLATE", _
        "Exit requested"

    success = _
        APS_RestoreFastVisibilitySnapshot( _
            "FAST_ISOLATE_EXIT")

    If success Then

        APS_FastIsolateActive = False
        APS_FastSnapshotValid = False
        APS_LastIsolateSelectionSignature = ""

        If APS_ComponentCount > 0 Then

            ReDim APS_FastCurrentVisiblePart( _
                0 To APS_ComponentCount - 1)

        End If

        frm.lblStatus.Caption = _
            "Exited Fast Isolate - original visibility restored"

        APS_Log _
            "FAST_ISOLATE", _
            "MODE OFF"

    Else

        frm.lblStatus.Caption = _
            "Fast Isolate restore had errors - see diagnostics"

        APS_PrintDiagnostics

    End If

    APS_IsolationBusy = False

End Sub


Public Function APS_IsMacroIsolationActive() As Boolean

    APS_IsMacroIsolationActive = _
        APS_FastIsolateActive

End Function


'===========================================================
' RIGHT CLICK SELECTION
'===========================================================

Public Sub APS_CaptureRightClickSelection( _
    ByVal frm As Object)

    Dim i As Long

    APS_RightClickListCount = _
        frm.lstResults.ListCount

    APS_RightClickSelectedCount = 0

    If APS_RightClickListCount <= 0 Then Exit Sub

    ReDim APS_RightClickSelection( _
        0 To APS_RightClickListCount - 1)

    For i = 0 To APS_RightClickListCount - 1

        APS_RightClickSelection(i) = _
            frm.lstResults.Selected(i)

        If APS_RightClickSelection(i) Then
            APS_RightClickSelectedCount = _
                APS_RightClickSelectedCount + 1
        End If

    Next i

End Sub


Public Sub APS_RestoreRightClickSelection( _
    ByVal frm As Object)

    Dim i As Long

    If APS_RightClickSelectedCount <= 1 Then Exit Sub

    If frm.lstResults.ListCount <> _
       APS_RightClickListCount Then Exit Sub

    APS_UpdatingResults = True

    For i = 0 To APS_RightClickListCount - 1

        frm.lstResults.Selected(i) = _
            APS_RightClickSelection(i)

    Next i

    APS_UpdatingResults = False

    APS_SyncListSelectionToSolidWorks _
        frm, _
        False

End Sub


'===========================================================
' RIGHT CLICK MENU
'===========================================================

Public Sub APS_ShowContextMenu( _
    ByVal frm As Object)

    Dim hMenu As LongPtr
    Dim ownerHwnd As LongPtr

    Dim pt As APS_POINTAPI

    Dim selectedCount As Long
    Dim commandID As Long

    Dim isolateCaption As String

    On Error GoTo MenuError

    APS_DisableWheelSubclass

    selectedCount = _
        APS_CountSelectedResults(frm)

    If selectedCount = 0 Then

        If frm.lstResults.ListCount <= 0 Then Exit Sub

        APS_UpdatingResults = True

        frm.lstResults.Selected(0) = True
        frm.lstResults.ListIndex = 0

        APS_UpdatingResults = False

        selectedCount = 1

        APS_SyncListSelectionToSolidWorks _
            frm, _
            False

    End If

    hMenu = APS_CreatePopupMenu

    If hMenu = 0 Then Exit Sub

    If selectedCount = 1 Then

        isolateCaption = _
            "Fast Isolate Selected"

    Else

        isolateCaption = _
            "Fast Isolate Selected (" & _
            CStr(selectedCount) & ")"

    End If

    APS_AppendMenu _
        hMenu, _
        APS_MF_STRING, _
        APS_MENU_ISOLATE, _
        isolateCaption

    APS_AppendMenu _
        hMenu, _
        APS_MF_SEPARATOR, _
        0, _
        vbNullString

    APS_AppendMenu _
        hMenu, _
        APS_MF_STRING, _
        APS_MENU_EXIT_ISOLATE, _
        "Exit Fast Isolate"

    APS_AppendMenu _
        hMenu, _
        APS_MF_SEPARATOR, _
        0, _
        vbNullString

    APS_AppendMenu _
        hMenu, _
        APS_MF_STRING, _
        APS_MENU_DIAGNOSTICS, _
        "Print Diagnostics"

    If APS_GetCursorPos(pt) = 0 Then GoTo CleanUp

    ownerHwnd = APS_GetForegroundWindow

    If ownerHwnd = 0 Then GoTo CleanUp

    APS_SetForegroundWindow ownerHwnd

    commandID = _
        APS_TrackPopupMenu( _
            hMenu, _
            APS_TPM_LEFTALIGN Or _
            APS_TPM_RIGHTBUTTON Or _
            APS_TPM_NONOTIFY Or _
            APS_TPM_RETURNCMD, _
            pt.X, _
            pt.Y, _
            0, _
            ownerHwnd, _
            0)

    APS_PostMessage _
        ownerHwnd, _
        APS_WM_NULL, _
        0, _
        0

    Select Case commandID

        Case APS_MENU_ISOLATE

            APS_IsolateSelected _
                frm, _
                frm.chkZoom.Value

        Case APS_MENU_EXIT_ISOLATE

            APS_ExitIsolate frm

        Case APS_MENU_DIAGNOSTICS

            APS_PrintDiagnostics

    End Select

CleanUp:

    If hMenu <> 0 Then
        APS_DestroyMenu hMenu
    End If

    Exit Sub

MenuError:

    APS_LogError _
        "APS_ShowContextMenu", _
        "Context Menu", _
        Err.Number, _
        Err.Description, _
        Err.Source

    Resume CleanUp

End Sub


'===========================================================
' MOUSE WHEEL
'
' NO WINDOWS HOOKS.
'
' While pointer is over lstResults:
'   - subclass the UserForm WndProc
'   - subclass the focused child WndProc, if the focus child
'     belongs to the UserForm
'
' Only WM_MOUSEWHEEL is intercepted.
'===========================================================

Public Sub APS_EnableWheelSubclass( _
    ByVal formCaption As String, _
    ByVal target As Object)

    Dim currentFormHwnd As LongPtr
    Dim currentFocusHwnd As LongPtr

    On Error GoTo SubclassError

    If APS_WheelShuttingDown Then Exit Sub

    currentFormHwnd = _
        APS_FindWindow( _
            vbNullString, _
            formCaption)

    If currentFormHwnd = 0 Then

        APS_LastSubclassError = _
            "Could not locate UserForm HWND"

        APS_Log _
            "WHEEL", _
            APS_LastSubclassError

        Exit Sub

    End If

    If APS_FormSubclassInstalled Then

        If APS_FormHwnd <> currentFormHwnd Then

            APS_Log _
                "WHEEL", _
                "Form HWND changed; rebuilding wheel routing"

            APS_DisableWheelSubclass

        End If

    End If

    APS_MouseOverList = True

    Set APS_WheelTarget = target

    If Not APS_FormSubclassInstalled Then

        APS_FormHwnd = currentFormHwnd

        APS_FormOriginalWndProc = _
            APS_InstallSubclass( _
                APS_FormHwnd)

        If APS_FormOriginalWndProc <> 0 Then

            APS_FormSubclassInstalled = True

            APS_Log _
                "WHEEL", _
                "Form subclass installed | hwnd=" & _
                CStr(APS_FormHwnd) & _
                " | class=" & _
                APS_GetWindowClassName(APS_FormHwnd)

        Else

            APS_LastSubclassError = _
                "Could not subclass UserForm window"

            APS_Log _
                "WHEEL", _
                APS_LastSubclassError

            Exit Sub

        End If

    End If

    currentFocusHwnd = _
        APS_GetValidFormFocusHwnd( _
            APS_FormHwnd)

    APS_EnsureFocusWheelSubclass _
        currentFocusHwnd

    Exit Sub

SubclassError:

    APS_LastSubclassError = _
        "APS_EnableWheelSubclass | Err=" & _
        CStr(Err.Number) & _
        " | " & _
        Err.Description

    APS_Log _
        "WHEEL", _
        APS_LastSubclassError

    APS_MouseOverList = False

End Sub


Public Sub APS_WheelTargetLeave()

    APS_MouseOverList = False

End Sub


Public Sub APS_RefreshWheelFocus( _
    ByVal formCaption As String, _
    ByVal target As Object)

    If APS_WheelShuttingDown Then Exit Sub

    If Not APS_FormSubclassInstalled Then

        APS_EnableWheelSubclass _
            formCaption, _
            target

        Exit Sub

    End If

    APS_MouseOverList = True

    Set APS_WheelTarget = target

    APS_EnsureFocusWheelSubclass _
        APS_GetValidFormFocusHwnd( _
            APS_FormHwnd)

End Sub


Private Function APS_GetValidFormFocusHwnd( _
    ByVal formHwnd As LongPtr) As LongPtr

    Dim currentFocusHwnd As LongPtr

    APS_GetValidFormFocusHwnd = 0

    If formHwnd = 0 Then Exit Function

    currentFocusHwnd = APS_GetFocus

    If currentFocusHwnd = 0 Then Exit Function

    If currentFocusHwnd = formHwnd Then

        APS_GetValidFormFocusHwnd = _
            currentFocusHwnd

        Exit Function

    End If

    If APS_IsChild( _
        formHwnd, _
        currentFocusHwnd) <> 0 Then

        APS_GetValidFormFocusHwnd = _
            currentFocusHwnd

    End If

End Function


Private Sub APS_EnsureFocusWheelSubclass( _
    ByVal newFocusHwnd As LongPtr)

    If APS_WheelShuttingDown Then Exit Sub

    If newFocusHwnd = 0 Or _
       newFocusHwnd = APS_FormHwnd Then

        APS_RemoveFocusWheelSubclass

        Exit Sub

    End If

    If APS_FocusSubclassInstalled Then

        If APS_FocusHwnd = newFocusHwnd Then
            Exit Sub
        End If

        APS_RemoveFocusWheelSubclass

    End If

    APS_FocusHwnd = newFocusHwnd

    APS_FocusOriginalWndProc = _
        APS_InstallSubclass( _
            APS_FocusHwnd)

    If APS_FocusOriginalWndProc <> 0 Then

        APS_FocusSubclassInstalled = True

        APS_Log _
            "WHEEL", _
            "Focus subclass installed | hwnd=" & _
            CStr(APS_FocusHwnd) & _
            " | class=" & _
            APS_GetWindowClassName(APS_FocusHwnd)

    Else

        APS_FocusHwnd = 0

        APS_LastSubclassError = _
            "Could not subclass focused child"

        APS_Log _
            "WHEEL", _
            APS_LastSubclassError

    End If

End Sub


Private Sub APS_RemoveFocusWheelSubclass()

    Dim oldFocusHwnd As LongPtr

    On Error Resume Next

    oldFocusHwnd = APS_FocusHwnd

    If APS_FocusSubclassInstalled Then

        If APS_FocusHwnd <> 0 And _
           APS_FocusOriginalWndProc <> 0 Then

            If APS_IsWindow(APS_FocusHwnd) <> 0 Then

                APS_SetWindowLongPtr _
                    APS_FocusHwnd, _
                    APS_GWLP_WNDPROC, _
                    APS_FocusOriginalWndProc

            End If

        End If

    End If

    APS_FocusSubclassInstalled = False
    APS_FocusHwnd = 0
    APS_FocusOriginalWndProc = 0

    If oldFocusHwnd <> 0 Then

        APS_Log _
            "WHEEL", _
            "Focus subclass removed"

    End If

    On Error GoTo 0

End Sub


Private Function APS_InstallSubclass( _
    ByVal hWnd As LongPtr) As LongPtr

    Dim previousProc As LongPtr
    Dim lastError As Long

    APS_InstallSubclass = 0

    If hWnd = 0 Then Exit Function

    If APS_IsWindow(hWnd) = 0 Then

        APS_LastSubclassError = _
            "APS_InstallSubclass invalid HWND=" & _
            CStr(hWnd)

        Exit Function

    End If

    APS_SetLastError 0

    previousProc = _
        APS_SetWindowLongPtr( _
            hWnd, _
            APS_GWLP_WNDPROC, _
            AddressOf APS_WheelWndProc)

    If previousProc = 0 Then

        lastError = APS_GetLastError

        APS_LastSubclassError = _
            "SetWindowLongPtr(" & _
            CStr(hWnd) & _
            ") returned 0; LastError=" & _
            CStr(lastError)

        Exit Function

    End If

    APS_InstallSubclass = previousProc

End Function


Public Sub APS_DisableWheelSubclass()

    Dim oldFormHwnd As LongPtr

    On Error Resume Next

    APS_WheelShuttingDown = True

    APS_MouseOverList = False
    APS_WheelBusy = False
    APS_WheelRemainder = 0

    APS_RemoveFocusWheelSubclass

    oldFormHwnd = APS_FormHwnd

    If APS_FormSubclassInstalled Then

        If APS_FormHwnd <> 0 And _
           APS_FormOriginalWndProc <> 0 Then

            If APS_IsWindow(APS_FormHwnd) <> 0 Then

                APS_SetWindowLongPtr _
                    APS_FormHwnd, _
                    APS_GWLP_WNDPROC, _
                    APS_FormOriginalWndProc

            End If

        End If

    End If

    APS_FormSubclassInstalled = False
    APS_FormHwnd = 0
    APS_FormOriginalWndProc = 0

    Set APS_WheelTarget = Nothing

    If oldFormHwnd <> 0 Then

        APS_Log _
            "WHEEL", _
            "Form subclass removed"

    End If

    APS_WheelShuttingDown = False

    On Error GoTo 0

End Sub


Public Function APS_WheelWndProc( _
    ByVal hWnd As LongPtr, _
    ByVal uMsg As Long, _
    ByVal wParam As LongPtr, _
    ByVal lParam As LongPtr) As LongPtr

    Dim wheelDelta As Long
    Dim oldProc As LongPtr

    On Error GoTo CallbackError

    oldProc = _
        APS_GetOriginalProcForHwnd( _
            hWnd)

    If APS_WheelShuttingDown Then
        GoTo ForwardMessage
    End If

    If uMsg = APS_WM_MOUSEWHEEL Then

        If APS_MouseOverList And _
           Not APS_WheelBusy Then

            If Not APS_WheelTarget Is Nothing Then

                wheelDelta = APS_GetWheelDelta(wParam)

                If wheelDelta <> 0 Then

                    APS_WheelBusy = True
                    APS_WheelEventCount = APS_WheelEventCount + 1
                    APS_LastWheelDelta = wheelDelta

                    APS_ScrollWheelTarget wheelDelta

                    APS_WheelBusy = False
                    APS_WheelWndProc = 0

                    Exit Function

                End If

            End If

        End If

    End If

ForwardMessage:

    APS_WheelBusy = False

    If oldProc <> 0 Then

        APS_WheelWndProc = _
            APS_CallWindowProc( _
                oldProc, _
                hWnd, _
                uMsg, _
                wParam, _
                lParam)

    Else

        APS_WheelWndProc = 0

    End If

    Exit Function

CallbackError:

    APS_LastSubclassError = _
        "WndProc Err=" & _
        CStr(Err.Number) & _
        " | " & _
        Err.Description

    APS_WheelBusy = False

    Resume ForwardMessage

End Function


Private Function APS_GetOriginalProcForHwnd( _
    ByVal hWnd As LongPtr) As LongPtr

    If APS_FocusSubclassInstalled Then

        If hWnd = APS_FocusHwnd Then

            APS_GetOriginalProcForHwnd = _
                APS_FocusOriginalWndProc

            Exit Function

        End If

    End If

    If APS_FormSubclassInstalled Then

        If hWnd = APS_FormHwnd Then

            APS_GetOriginalProcForHwnd = _
                APS_FormOriginalWndProc

            Exit Function

        End If

    End If

End Function


Private Function APS_GetWheelDelta( _
    ByVal wParam As LongPtr) As Long

#If Win64 Then

    Dim rawValue As LongLong
    Dim highWord As LongLong

    rawValue = wParam
    highWord = (rawValue \ 65536) Mod 65536

    If highWord < 0 Then
        highWord = highWord + 65536
    End If

    If highWord >= 32768 Then
        highWord = highWord - 65536
    End If

    APS_GetWheelDelta = CLng(highWord)

#Else

    Dim highWord32 As Long

    highWord32 = (wParam \ 65536) And &HFFFF&

    If highWord32 >= 32768 Then
        highWord32 = highWord32 - 65536
    End If

    APS_GetWheelDelta = highWord32

#End If

End Function


Private Sub APS_ScrollWheelTarget( _
    ByVal wheelDelta As Long)

    Dim wheelNotches As Long
    Dim oldTop As Long
    Dim newTop As Long
    Dim listCount As Long

    On Error GoTo Finished

    If APS_WheelTarget Is Nothing Then Exit Sub

    listCount = APS_WheelTarget.ListCount

    If listCount <= 1 Then Exit Sub

    APS_WheelRemainder = APS_WheelRemainder + wheelDelta

    If Abs(APS_WheelRemainder) < APS_WHEEL_DELTA Then Exit Sub

    wheelNotches = _
        Fix( _
            CDbl(APS_WheelRemainder) / _
            CDbl(APS_WHEEL_DELTA))

    APS_WheelRemainder = _
        APS_WheelRemainder - _
        (wheelNotches * APS_WHEEL_DELTA)

    oldTop = APS_WheelTarget.TopIndex

    If oldTop < 0 Then oldTop = 0

    newTop = _
        oldTop - _
        (wheelNotches * APS_SCROLL_LINES)

    If newTop < 0 Then newTop = 0

    If newTop > listCount - 1 Then
        newTop = listCount - 1
    End If

    If newTop <> oldTop Then
        APS_WheelTarget.TopIndex = newTop
    End If

Finished:

End Sub


Private Function APS_GetWindowClassName( _
    ByVal hWnd As LongPtr) As String

    Dim buffer As String
    Dim length As Long

    If hWnd = 0 Then Exit Function
    If APS_IsWindow(hWnd) = 0 Then Exit Function

    buffer = String$(256, vbNullChar)

    length = _
        APS_GetClassName( _
            hWnd, _
            buffer, _
            255)

    If length > 0 Then
        APS_GetWindowClassName = Left$(buffer, length)
    End If

End Function


'===========================================================
' TEXT HELPERS
'===========================================================

Private Function APS_NormalizeText( _
    ByVal text As String) As String

    Dim separators As Variant
    Dim separator As Variant

    text = LCase$(Trim$(text))

    text = _
        Replace$( _
            text, _
            ".sldprt", _
            "")

    text = _
        Replace$( _
            text, _
            ".sldasm", _
            "")

    separators = _
        Array( _
            "-", _
            "_", _
            ".", _
            "/", _
            "\", _
            "^", _
            "@", _
            "(", _
            ")", _
            "[", _
            "]", _
            "{", _
            "}", _
            ",", _
            ";", _
            ":", _
            vbTab)

    For Each separator In separators

        text = _
            Replace$( _
                text, _
                CStr(separator), _
                " ")

    Next separator

    APS_NormalizeText = _
        APS_CollapseSpaces(text)

End Function


Private Function APS_CollapseSpaces( _
    ByVal text As String) As String

    Dim i As Long
    Dim ch As String

    Dim result As String
    Dim previousWasSpace As Boolean

    For i = 1 To Len(text)

        ch = Mid$(text, i, 1)

        If ch = " " Then

            If Not previousWasSpace Then

                result = result & " "
                previousWasSpace = True

            End If

        Else

            result = result & ch
            previousWasSpace = False

        End If

    Next i

    APS_CollapseSpaces = Trim$(result)

End Function


Private Function APS_CompactText( _
    ByVal text As String) As String

    APS_CompactText = _
        Replace$( _
            APS_NormalizeText(text), _
            " ", _
            "")

End Function


Private Function APS_SafeGetPath( _
    ByVal swComp As SldWorks.Component2) As String

    On Error Resume Next

    APS_SafeGetPath = _
        swComp.GetPathName

    On Error GoTo 0

End Function


Private Function APS_SafeGetComponentName( _
    ByVal swComp As SldWorks.Component2) As String

    On Error Resume Next

    APS_SafeGetComponentName = _
        swComp.Name2

    On Error GoTo 0

End Function


Private Function APS_GetFileBaseName( _
    ByVal fullPath As String) As String

    Dim fileName As String

    Dim slash1 As Long
    Dim slash2 As Long
    Dim slashPosition As Long

    Dim dotPosition As Long

    If Len(fullPath) = 0 Then Exit Function

    slash1 = InStrRev(fullPath, "\")
    slash2 = InStrRev(fullPath, "/")

    If slash1 > slash2 Then
        slashPosition = slash1
    Else
        slashPosition = slash2
    End If

    If slashPosition > 0 Then

        fileName = _
            Mid$( _
                fullPath, _
                slashPosition + 1)

    Else

        fileName = fullPath

    End If

    dotPosition = InStrRev(fileName, ".")

    If dotPosition > 1 Then

        fileName = _
            Left$( _
                fileName, _
                dotPosition - 1)

    End If

    APS_GetFileBaseName = fileName

End Function


Private Function APS_GetLeafComponentName( _
    ByVal fullName As String) As String

    Dim position As Long

    position = InStrRev(fullName, "/")

    If position > 0 Then

        APS_GetLeafComponentName = _
            Mid$( _
                fullName, _
                position + 1)

    Else

        APS_GetLeafComponentName = fullName

    End If

End Function


Private Function APS_RemoveInstanceSuffix( _
    ByVal componentName As String) As String

    Dim dashPosition As Long
    Dim suffix As String

    dashPosition = InStrRev(componentName, "-")

    If dashPosition <= 0 Then

        APS_RemoveInstanceSuffix = componentName
        Exit Function

    End If

    suffix = _
        Mid$( _
            componentName, _
            dashPosition + 1)

    If IsNumeric(suffix) Then

        APS_RemoveInstanceSuffix = _
            Left$( _
                componentName, _
                dashPosition - 1)

    Else

        APS_RemoveInstanceSuffix = componentName

    End If

End Function
Procedure index · 71 declarations
Filter procedures
File checksum
SHA-256: 5cf7d0b9cd6cccc2b528db5e7dfbb30ee5242166df5f4db2e1e359f7f651b790
Prerequisites

Additional setup

How the workflow fits together.

Preflight the host and form

Rank component names

Navigate and isolate

Restore transient state

Output & model changes

Read the implementation.

AssemblyPartSearch.bas
