Hi,
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
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"
End
Else
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
Thanks
SolidworksApi macros