2 Replies Latest reply on Aug 17, 2017 9:39 PM by Prabaharan Pichaiyan

    Select Sub-Assembly by custom Properties

    Prabaharan Pichaiyan



      I need to select Sub assembly (Not Top level) by its Custom Property.

      I have Codes to select component by Custom property, Is there any way to select sub Assembly?

      Option Explicit
          Dim swApp                      As Object
          Dim swModel                    As Object
          Dim swConf                      As Object
          Dim swRootComp                  As Object
      Sub main()
          Dim swApp As SldWorks.SldWorks
          Dim swModel As SldWorks.ModelDoc2
          Dim str As String
          ' Constant enumerators
          Const swDocPART = 1
          Const swDocASSEMBLY = 2
          Const swDocDRAWING = 3
          Set swApp = CreateObject("SldWorks.Application")
          Set swModel = swApp.ActiveDoc
          If swModel Is Nothing Then
              ' If no model currently loaded, then exit
          End If
          ' Determine the document type
          ' If the document is not a drawing, then send a message to the user
          If (swModel.GetType <> swDocASSEMBLY) Then
              MsgBox "This Feature only for ASSEMBLY !", vbCritical, "Avantek Tools"
           Call TRAVCOMP
           Debug.Print "ok"
          End If
      End Sub
      Sub TraverseComponent(swComp As Object, nLevel As Long)
          Dim vChildComp                  As Variant
          Dim swChildComp                As Object
          Dim swCompConfig                As Object
          Dim sPadStr                    As String
          Dim i                          As Long
          Dim retval, retval1                      As String
          Dim bRet                        As Boolean
      For i = 0 To nLevel - 1
              sPadStr = sPadStr + "  "
          Next i
          vChildComp = swComp.GetChildren
          For i = 0 To UBound(vChildComp)
              Set swChildComp = vChildComp(i)
              TraverseComponent swChildComp, nLevel + 1
              Set swModel = swChildComp.GetModelDoc
              If Not swModel Is Nothing Then
                  retval1 = swModel.CustomInfo2("", "Description")
                    If InStr((retval1), "StripLayout") > 0 Then
                      bRet = swChildComp.Select(True) 'SELECTS COMPONENT
                  End If
              End If
          Next i
      End Sub
       Sub TRAVCOMP()
          Set swApp = CreateObject("SldWorks.Application")
          Set swModel = swApp.ActiveDoc
          Set swConf = swModel.GetActiveConfiguration
          Set swRootComp = swConf.GetRootComponent
          Debug.Print "File = " & swModel.GetPathName
          Dim swModel2 As SldWorks.ModelDoc2
          Set swApp = Application.SldWorks
          Set swModel2 = swApp.ActiveDoc
          swModel2.ClearSelection2 True
          TraverseComponent swRootComp, 1
          Dim obj As Object
          swModel.Extension.RunCommand swCommands_HideShowComponents, Empty
      swModel2.ClearSelection2 True
      End Sub