0 Replies Latest reply on Oct 16, 2018 5:44 AM by Cad Admin

    VBA - Get component in assembly with broken or out of context references

    Cad Admin

      I see by 2018 SOLIDWORKS API Help - Get External References (VBA) that i can retrieve the information for the feature level.

      I just need to Traverse through and assembly and return the names of the component that have broken or out of context references.

       

      i see by 2018 SOLIDWORKS API Help - swExternalReferenceStatus_e Enumeration im looking to only report on files with 0 or 4. but I'm my macro I'm getting a debug line for any line with a referencecount greater than 0...so basically any model with an external reference.

       

      This is a pretty muddy macro(there are some unneeded things still around)...so

       

      Option Explicit

       

      Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long)

         

          Dim swApp                   As SldWorks.SldWorks

          Dim swModel                 As SldWorks.ModelDoc2

          Dim swModDocExt             As SldWorks.ModelDocExtension

          Dim swSelMgr                As SldWorks.SelectionMgr

          Dim swFeat                  As SldWorks.Feature

          Dim vModelPathName          As Variant

          Dim vComponentPathName      As Variant

          Dim vFeature                As Variant

          Dim vDataType               As Variant

          Dim vStatus                 As Variant

          Dim vRefEntity              As Variant

          Dim vFeatComp               As Variant

          Dim nConfigOpt              As Long

          Dim sConfigName             As String

          Dim nRefCount               As Long

          Dim nSelType                As Long

          Dim i                       As Long

          Dim j                       As Long

          Dim swConfigMgr             As SldWorks.ConfigurationManager

          Dim vChildUComp             As Variant

          Dim swChildUComp            As SldWorks.Component2

          Dim swCompUConfig           As SldWorks.Configuration

          Dim sPadStr                 As String

          Dim CheckPromote            As Integer

          Dim CheckResults            As String

       

          Set swApp = CreateObject("SldWorks.Application")

          Set swModel = swApp.ActiveDoc

          Set swSelMgr = swModel.SelectionManager

       

          Set swModDocExt = swModel.Extension

          nSelType = swSelMgr.GetSelectedObjectType3(1, -1)

         

          For j = 0 To nLevel - 1

              sPadStr = sPadStr + "  "

          Next j

             

          vChildUComp = swComp.GetChildren

             

          For j = 0 To UBound(vChildUComp)

              Set swChildUComp = vChildUComp(j)

             

              TraverseComponent swChildUComp, nLevel + 1

                  nRefCount = swChildUComp.ListExternalFileReferencesCount

                 

                  swChildUComp.ListExternalFileReferences2 vModelPathName, vComponentPathName, vFeature, vDataType, vStatus, vRefEntity, vFeatComp, nConfigOpt, sConfigName

       

              Set swModel = swChildUComp.GetModelDoc2

             

              If nRefCount > 0 Then

             

                  Debug.Print "Model name: " + swChildUComp.GetPathName

                 

                  For i = 0 To nRefCount - 1

                      If Str(vStatus(i)) = 0 Then

                          Debug.Print "    Out of Context Model path + name     : " + vModelPathName(i)

                          Debug.Print "    Out of Context Feature               : " + vFeature(i)

                          Debug.Print "    Out of Context Data type             : " + vDataType(i)

                          Debug.Print "    Out of Context Status                : " + Str(vStatus(i)) & " (Broken)"

                          Debug.Print "    Out of Context Reference entity      : " + vRefEntity(i)

                          Debug.Print " "

                      End If

             

                      If Str(vStatus(i)) = 4 Then

                          Debug.Print "    Out of Context Model path + name     : " + vModelPathName(i)

                          Debug.Print "    Out of Context Feature               : " + vFeature(i)

                          Debug.Print "    Out of Context Data type             : " + vDataType(i)

                          Debug.Print "    Out of Context Status                : " + Str(vStatus(i)) & " (Out of Context)"

                          Debug.Print "    Out of Context Reference entity      : " + vRefEntity(i)

                          Debug.Print " "

                      End If

                  Next i

              End If

          Next j

      End Sub

       

      Sub main()

       

          Dim swApp                   As SldWorks.SldWorks

          Dim swModel                 As SldWorks.ModelDoc2

          Dim swAssy                  As SldWorks.AssemblyDoc

          Dim swConf                  As SldWorks.Configuration

          Dim swRootComp              As SldWorks.Component2

          Dim bRet                    As Boolean

          Dim Filename                As String

          Dim errors                  As Long

          Dim warnings                As Long

       

          Set swApp = Application.SldWorks

          Set swModel = swApp.ActiveDoc

         

          If swModel Is Nothing Then

              MsgBox "Please open an Assembly file", vbExclamation, "No File Loaded"

              End

          End If

       

          If swModel.GetType = 1 Then '1 = part, 2 = assembly, 3 = drawing

              MsgBox "File is a Part, Please open an Assembly", vbExclamation, "File Mismatch"

              End

          End If

         

          If swModel.GetType = 3 Then '1 = part, 2 = assembly, 3 = drawing

              MsgBox "File is a Drawing, Please open an Assembly", vbExclamation, "File Mismatch"

              End

          End If

       

          Set swConf = swModel.GetActiveConfiguration

          Set swRootComp = swConf.GetRootComponent3(True)

         

          TraverseComponent swRootComp, 1

       

      End Sub