Attribute VB_Name = "FixFloatToggle1"
' --------------------------------------------------------------------04/03/2007
' FixFloatToggle.swp                Written by Leonard Kikstra,
'                                   Copyright 2007, Leonard Kikstra
'                                   Downloaded from Lenny's SolidWorks Resources
'                                        at http://www.lennyworks.com/solidworks
' ------------------------------------------------------------------------------
' FixFloatToggle1:      Macro is launched from "main" subroutine in this module.
' ------------------------------------------------------------------------------
' Notes:                Component must be selected before launching macro.
' ------------------------------------------------------------------------------
Option Explicit

Const MyMacroName = "FixFloatToggle"

'------------------------------------------------------------------------------
' This function will locate the occurance of "stringToFind" inside "theString".
'   Occur  = 0       Get first occurrance
'            1       Get last occurrance
' From that position, it will return text based on the 'Retrieve' variable.
'   StrRet = 0       Get text before
'            1       Get text after
'            2       If no occurrance found, return blank
'------------------------------------------------------------------------------
Function NewParseString(theString As String, stringToFind As String, _
                            Occur As Boolean, StrRet As Integer)
  Dim Location As Integer, TempLoc As Integer, PosCount As Integer
  Location = 0
  TempLoc = 0
  PosCount = 1
  While PosCount < Len(theString)
    TempLoc = InStr(PosCount, theString, stringToFind)
    If TempLoc <> 0 Then
      If Occur = 0 Then
        If Location = 0 Then
          Location = TempLoc
        End If
      Else
        Location = TempLoc
      End If
      PosCount = TempLoc + 1
    Else
      PosCount = Len(theString)
    End If
  Wend
  If Location <> 0 Then
    If StrRet = 0 Then
      theString = Mid(theString, 1, Location - 1)
    Else
      theString = Mid(theString, Location + Len(stringToFind))
    End If
  ElseIf StrRet = 2 Then
    theString = ""
  End If
  NewParseString = theString
End Function

Sub main()
  
  Dim swApp             As Object
  Dim swModel           As Object
  Dim FileTyp           As Integer
  Dim swSelMgr          As Object
  Dim boolstat          As Boolean
  Dim longstat          As Long
  Dim longwarn          As Long
  Dim Count             As Integer
  Dim MyCount           As Integer
  Dim CompSelect        As Object
  Dim HoldSelect()      As String
  Dim HoldStatus()      As Boolean
  Dim HoldCount         As Integer
  Dim StatFloat         As Integer
  Dim StatFixed         As Integer
  Dim SelType           As String
  Dim AssemTitle        As String
  Dim GetComponent      As String
  
  ' Attach to SolidWorks
  Set swApp = Application.SldWorks
  ' Get active document
  Set swModel = swApp.ActiveDoc
  If Not swModel Is Nothing Then
    FileTyp = swModel.GetType
    If FileTyp = swDocASSEMBLY Then
  
      ' Get assembly title
      AssemTitle = NewParseString(swModel.GetTitle, ".", 1, 0)  ' Need title
      
      ' Get selection manager
      Set swSelMgr = swModel.SelectionManager
      ' Get number of selections
      Count = swSelMgr.GetSelectedObjectCount2(-1)
      ' Set my counter
      HoldCount = 0
  
      ' First count thru, collect mate names and suppression status.
      ' This must be done because any selections will be cleared and we don't
      ' want to loose these selections.
      ' We can access selections by their names in the second count thru.
      If Count > 0 Then                                     ' Is anything selected
      ReDim HoldSelect(Count)
      ReDim HoldStatus(Count)
    
        For MyCount = 1 To Count
          ' What type of object was selected
          SelType = swSelMgr.GetSelectedObjectType3(MyCount, -1)
          ' Is it a mate?
          If swSelMgr.GetSelectedObjectType3(MyCount, -1) = swSelCOMPONENTS Then
            ' For components only
            Set CompSelect = swSelMgr.GetSelectedObject6(MyCount, -1)
            If Not CompSelect Is Nothing Then
              HoldSelect(HoldCount) = CompSelect.Name           ' Get name
              HoldStatus(HoldCount) = CompSelect.IsFixed        ' Get status
              HoldCount = HoldCount + 1                         ' Increment counter
            End If
          End If
        Next MyCount
    
        swModel.ClearSelection2 True                            ' Clear selections
    
        ' Second count thru, invert mate's suppress/unsuppress state.
        ' We are not only woking with mates beyond this point, and first selections
        ' have already been cleared.
        If HoldCount > 0 Then
          StatFloat = 0                                          ' Counter
          StatFixed = 0                                          ' Counter
          For MyCount = 0 To HoldCount - 1
            GetComponent = HoldSelect(MyCount) & "@" & AssemTitle
            If swModel.Extension.SelectByID2(GetComponent, "COMPONENT", _
                            0, 0, 0, False, 0, Nothing, 0) = True Then
              If HoldStatus(MyCount) = True Then
                swModel.UnfixComponent                          ' FLOAT component
                StatFixed = StatFixed + 1                       ' Increment counter
              Else
                swModel.FixComponent                            ' FIX component
                StatFloat = StatFloat + 1                       ' Increment counter
              End If
            End If
          swModel.ClearSelection2 True                          ' Clear selection
          Next MyCount
          MsgBox StatFloat & " components FIXED." & Chr(13) & _
                 StatFixed & " components FLOAT.", _
                 vbExclamation, MyMacroName ' Tell user what changed
        Else: MsgBox "No componet(s) selected.", vbExclamation, MyMacroName
        End If
  
      Else: MsgBox "Nothing selected.", vbExclamation, MyMacroName
      End If
    
    Else: MsgBox "Document is not an assembly.", vbExclamation, MyMacroName
    End If
  
  Else: MsgBox "No document loaded.", vbExclamation, MyMacroName
  End If

End Sub


