10 Replies Latest reply on Mar 12, 2015 9:13 AM by Paul Flores

    Export to Excel only parts with properties that meet a criteria

    Paul Flores

      The below macro, found on this forum, exports mass and COM (to Excel) of all parts in an open assembly.

       

      Dim swApp As SldWorks.SldWorks
      Dim SwModel As SldWorks.ModelDoc2
      Dim swModExt As SldWorks.ModelDocExtension
      Dim swAssembly As SldWorks.AssemblyDoc
      Dim SwComp As SldWorks.Component2
      Dim MassProp As SldWorks.MassProperty
      Dim Component As Variant
      Dim Components As Variant
      Dim Bodies As Variant
      Dim BodyInfo As Variant
      Dim CenOfM As Variant
      Dim RetBool As Boolean
      Dim RetVal As Long
      Dim xlApp As Excel.Application
      Dim xlWorkBooks As Excel.Workbooks
      Dim xlBook As Excel.Workbook
      Dim xlsheet As Excel.Worksheet
      Dim OutputPath As String
      Dim OutputFN As String
      Dim xlCurRow As Integer
      
      Sub main()
      Set swApp = Application.SldWorks
      Set SwModel = swApp.ActiveDoc
      
      If SwModel Is Nothing Then
              swApp.SendMsgToUser2 "An assembly must be an active document.", swMbWarning, swMbOk
              Exit Sub
            End If
                     
      If SwModel.GetType <> swDocASSEMBLY Then
              swApp.SendMsgToUser2 "An assembly must be an active document.", swMbWarning, swMbOk
              Exit Sub
      Else
      Set swAssembly = SwModel
      End If
      
      Set swModExt = SwModel.Extension
      Set MassProp = swModExt.CreateMassProperty
      OutputPath = Environ("USERPROFILE") & "\Desktop\"
      OutputFN = SwModel.GetTitle & ".xlsx"
      If Dir(OutputPath & OutputFN) <> "" Then
      Kill OutputPath & OutputFN
      End If
      Set xlApp = Excel.Application
      xlApp.Visible = True
      Set xlWorkBooks = Excel.Workbooks
      Set xlBook = xlWorkBooks.Add()
      Set xlsheet = xlBook.Worksheets("Sheet1")
      xlsheet.Range("A1").Value = "Component"
      xlsheet.Range("B1").Value = "X Loc (mm)"
      xlsheet.Range("C1").Value = "Y Loc (mm)"
      xlsheet.Range("D1").Value = "Z Loc (mm)"
      xlsheet.Range("E1").Value = "Mass (kg)"
      xlsheet.Range("F1").Value = "Type"
      xlBook.SaveAs OutputPath & OutputFN
      xlCurRow = 2
      RetVal = swAssembly.ResolveAllLightWeightComponents(False)
      Components = swAssembly.GetComponents(False)
      For Each Component In Components
          Set SwComp = Component
          If SwComp.GetSuppression <> 0 Then
          'If LCase(Right(SwComp.GetPathName, 3)) <> "asm" Then
              Bodies = SwComp.GetBodies2(0)
      'MsgBox SwComp.Name
              'If Bodies <> Empty Then
                  RetBool = MassProp.AddBodies(Bodies)
                  CenOfM = MassProp.CenterOfMass
                  
                  xlsheet.Range("A" & xlCurRow).Value = SwComp.Name
                  xlsheet.Range("B" & xlCurRow).Value = CenOfM(0) * 1000
                  xlsheet.Range("C" & xlCurRow).Value = CenOfM(1) * 1000
                  xlsheet.Range("D" & xlCurRow).Value = CenOfM(2) * 1000
                  xlsheet.Range("E" & xlCurRow).Value = MassProp.Mass
                  
                  If LCase(Right(SwComp.GetPathName, 3)) = "asm" Then
                  xlsheet.Range("F" & xlCurRow).Value = "Assembly"
                  ElseIf LCase(Right(SwComp.GetPathName, 3)) = "prt" Then
                  xlsheet.Range("F" & xlCurRow).Value = "Part"
                  Else
                  xlsheet.Range("F" & xlCurRow).Value = "Undetermined"
                  End If 'Right 3 of file extension
                  xlCurRow = xlCurRow + 1
                              
              'End If 'UBound(Bodies) <> -1
              
          'End If 'Not an Assembly
          End If 'swComp.GetSuppression <> 0
      Next Component
      
      xlsheet.UsedRange.EntireColumn.AutoFit
      xlBook.Save
      'xlWorkBooks.Close
      'xlApp.Quit
      End Sub
      

       

      I was wondering how to modify it to export only parts with properties that meet a certain criteria. We have a configuration specific property in our parts called "Type" and we fill in "plate", "sheet", "round bar", etc.  What I need the macro to do is find the parts that have the "Type" property with either "plate" or "sheet" filled in, then export only those files to Excel.

       

      Here are what the columns in Excel would be:

       

      xlsheet.Range("A1").Value = "Filename-configuration"

      xlsheet.Range("B1").Value = "Type"

      xlsheet.Range("C1").Value = "Description"

       

      Any help would be appreciated.

        • Re: Export to Excel only parts with properties that meet a criteria
          Deepak Gupta

          You can set the macro to check the value of the custom property. And if the name/returned value is "Type" then extract the proprieties else move to next component.

            • Re: Export to Excel only parts with properties that meet a criteria
              Paul Flores

              I was able to get it to write the configuration-specific properties of "Type" and "Description" with the code below, but still do not know how to write the IF-ELSE statement.

               

              Option Explicit
              Dim swApp As ISldWorks
              Dim SwModel As IModelDoc2
              Dim swModExt As IModelDocExtension
              Dim swAssembly As IAssemblyDoc
              Dim swComp As IComponent2
              Dim MassProp As IMassProperty
              Dim Component As Variant
              Dim Components As Variant
              Dim Bodies As Variant
              Dim BodyInfo As Variant
              Dim CenOfM As Variant
              Dim RetBool As Boolean
              Dim Path As Variant
              Dim RetVal As Long
              Dim xlApp As Excel.Application
              Dim xlWorkBooks As Excel.Workbooks
              Dim xlBook As Excel.Workbook
              Dim xlsheet As Excel.Worksheet
              Dim OutputPath As String
              Dim OutputFN As String
              Dim xlCurRow As Integer
              Dim swFeat As IFeature
              
              Sub main()
              
              'Get active drawing view
              
              Set swApp = Application.SldWorks
              Set SwModel = swApp.ActiveDoc
              
              If SwModel Is Nothing Then
                      swApp.SendMsgToUser2 "An assembly must be an active document.", swMbWarning, swMbOk
                    Exit Sub
                    End If
                         
              If SwModel.GetType <> swDocASSEMBLY Then
                      swApp.SendMsgToUser2 "An assembly must be an active document.", swMbWarning, swMbOk
                      Exit Sub
              Else
              Set swAssembly = SwModel
              End If
              
              'Open Excel
              
              Set swModExt = SwModel.Extension
              Set MassProp = swModExt.CreateMassProperty
              
              Set xlApp = Excel.Application
              xlApp.Visible = True
              Set xlWorkBooks = Excel.Workbooks
              Set xlBook = xlWorkBooks.Add()
              Set xlsheet = xlBook.Worksheets("Sheet1")
              
              'Populate Excel Spreadsheet Titles
              
              xlsheet.Range("A1").Value = "Part"
              xlsheet.Range("B1").Value = "TYPE"
              xlsheet.Range("C1").Value = "DESCRIPTION"
              
              'Set current row to 2
              
              xlCurRow = 2
              
              'RetVal = swAssembly.ResolveAllLightWeightComponents(False)
              Components = swAssembly.GetComponents(0)
              
              'Loop to populate excel spreadsheet
              
              On Error Resume Next
              
              For Each Component In Components
                  Set swComp = Component
              
                If swComp.GetSuppression <> 0 And Not swComp.IsHidden(True) Then
                   
                      Bodies = swComp.GetBodies2(0)
                   
                          RetBool = MassProp.AddBodies(Bodies)
                          CenOfM = MassProp.CenterOfMass
                       
                          xlsheet.Range("A" & xlCurRow).Value = swComp.Name
                          xlsheet.Range("B" & xlCurRow).Value = GetCustomProperty(swComp, "TYPE")
                          xlsheet.Range("C" & xlCurRow).Value = GetCustomProperty(swComp, "DESCRIPTION")
                          xlCurRow = xlCurRow + 1
                       
              End If
              
              Next Component
              
              'Auto fits sheeet, saves, and quits excel
              
              xlsheet.UsedRange.EntireColumn.AutoFit
              'xlBook.Save
              'xlWorkBooks.Close
              'xlApp.Quit
              
              End Sub
              
              Private Function GetCustomProperty(myComp As Component2, myProp As String) As String
                  Dim myDoc As ModelDoc2
                  Dim sa As Variant
                  Dim i As Integer
                  Dim myVal As String
                  Dim myValOut As String
                  Dim myMgr As CustomPropertyManager
                  Dim retB As Boolean
              
                Set myDoc = myComp.GetModelDoc2
              '    If myDoc Is Nothing Then Exit Sub 'This will happen if you load your assembly lightweight
                      Set myMgr = myDoc.Extension.CustomPropertyManager(SwModel.ConfigurationManager.ActiveConfiguration.Name)
                  GetCustomProperty = ""
                  sa = myMgr.GetNames
              '    If IsEmpty(sa) Then Exit Function
                  For i = 0 To UBound(sa)
                      If sa(i) = myProp Then
                          retB = myMgr.Get4(sa(i), False, myVal, myValOut)
                          GetCustomProperty = myValOut
                          Exit Function
                      End If
                  Next
                 
              End Function
              
                • Re: Export to Excel only parts with properties that meet a criteria
                  Deepak Gupta

                  Sorry took me a little while to figure it out. Here is updated macro.

                    • Re: Export to Excel only parts with properties that meet a criteria
                      Paul Flores

                      First, I want to say thank you for your help and your time.

                       

                      When I run the macro, it would create the Excel file, create the columns "Filename-configuration", "Type" and "Description", but it didn't fill in the parts that fit the criteria.  Since I'm new to API, I put Debug.Print below several lines to see what was happening as shown below:

                       

                      'Export Part Configuration Properties from Assembly.swp ------------- 03/11/15
                      'Description: Macro to export specific Part Configuration properties from active assembly.
                      'Pre-Condition: An active assembly with one component.
                      ' Please back up your data before use and USE AT OWN RISK
                      '
                      '------------------------------------------------------------------------------------
                      'Created by Deepak Gupta (Boxer's SOLIDWORKS Blog, India) http://gupta9665.com/
                      '------------------------------------------------------------------------------------
                      ' Disclaimer:
                      ' This macro is provided as is.  No claims, support, refund, safety net, or
                      ' warranties are expressed or implied.  By using this macro and/or its code in
                      ' any way whatsoever, the user and any entities which the user represents,
                      ' agree to hold the authors free of any and all liability.
                      ' Free distribution and use of this code in other free works is welcome.
                      ' You may redistribute it and/or modify it on the condition that this header is retained.
                      ' All other forms of distribution (i.e., not free, fee for delivery, etc) are prohibited
                      ' without the expressed written consent by the authors.
                      ' Use at your own risk!
                      ' ------------------------------------------------------------------------------
                      Option Explicit
                      
                      Dim swApp               As SldWorks.SldWorks
                      Dim SwModel             As SldWorks.ModelDoc2
                      Dim swModExt            As SldWorks.ModelDocExtension
                      Dim swAssembly          As SldWorks.AssemblyDoc
                      Dim SwComp              As SldWorks.Component2
                      Dim Component           As Variant
                      Dim Components          As Variant
                      Dim RetVal              As Long
                      Dim xlApp               As Excel.Application
                      Dim xlWorkBooks         As Excel.Workbooks
                      Dim xlBook              As Excel.Workbook
                      Dim xlsheet             As Excel.Worksheet
                      Dim OutputPath          As String
                      Dim OutputFN            As String
                      Dim xlCurRow            As Integer
                      Dim swCompModel         As SldWorks.ModelDoc2
                      Dim swConfigMgr         As CustomPropertyManager
                      Dim val                 As String
                      Dim valout              As String
                      
                      Sub main()
                      
                      Debug.Print "Begin Export Part Configuration Properties"
                      Set swApp = Application.SldWorks
                      Set SwModel = swApp.ActiveDoc
                        
                      Debug.Print "Check if assembly or part"
                      If SwModel Is Nothing Then
                              swApp.SendMsgToUser2 "An assembly must be an active document.", swMbWarning, swMbOk
                              Exit Sub
                      End If
                                       
                      If SwModel.GetType <> swDocASSEMBLY Then
                              swApp.SendMsgToUser2 "An assembly must be an active document.", swMbWarning, swMbOk
                              Exit Sub
                      Else
                      Set swAssembly = SwModel
                      End If
                        
                      Set swModExt = SwModel.Extension
                      OutputPath = Environ("USERPROFILE") & "\Desktop\"
                      Debug.Print OutputPath
                      OutputFN = SwModel.GetTitle & ".xlsx"
                      Debug.Print OutputFN
                      
                      If Dir(OutputPath & OutputFN) <> "" Then
                      Debug.Print OutputPath & OutputFN
                      Kill OutputPath & OutputFN
                      Debug.Print "Kill - "; OutputPath & OutputFN
                      End If
                      
                      Set xlApp = Excel.Application
                      xlApp.Visible = True
                      Set xlWorkBooks = Excel.Workbooks
                      Set xlBook = xlWorkBooks.Add()
                      Set xlsheet = xlBook.Worksheets("Sheet1")
                      
                      xlsheet.Range("A1").Value = "Filename-configuration"
                      Debug.Print "A1 Filename-configuration"
                      xlsheet.Range("B1").Value = "Type"
                      Debug.Print "B1 Value"
                      xlsheet.Range("C1").Value = "Description"
                      Debug.Print "C1 Description"
                      xlBook.SaveAs OutputPath & OutputFN
                      Debug.Print "SaveAs - "; OutputPath & OutputFN
                      xlCurRow = 2
                      
                      RetVal = swAssembly.ResolveAllLightWeightComponents(False)
                      Components = swAssembly.GetComponents(False)
                      For Each Component In Components
                      Debug.Print "For Each Component"
                          Set SwComp = Component
                            
                          If SwComp.GetSuppression <> 0 And Not SwComp.IsHidden(True) Then
                          Set swCompModel = SwComp.GetModelDoc2
                          
                          Set swConfigMgr = swCompModel.Extension.CustomPropertyManager(SwComp.ReferencedConfiguration)
                              swConfigMgr.Get4 "Type", False, val, valout
                              Debug.Print "If Type False val, valout"
                                  If valout Like "Plate" Or valout Like "Sheet" Then
                                  Debug.Print "If valout Like Plate or Sheet Then"
                                     xlsheet.Range("A" & xlCurRow).Value = SwComp.Name
                                     Debug.Print "A and xlcurRow"
                                     xlsheet.Range("B" & xlCurRow).Value = valout
                                     Debug.Print "B and xlcurRow"
                                     swConfigMgr.Get4 "Description", False, val, valout
                                     xlsheet.Range("C" & xlCurRow).Value = valout
                                     Debug.Print "C and xlcurRow"
                                     
                                  Else
                                     GoTo NextComp
                                  End If
                                            
                              xlCurRow = xlCurRow + 1
                             
                          End If
                          
                        NextComp:
                      Next Component
                        
                      xlsheet.UsedRange.EntireColumn.AutoFit
                      xlBook.Save
                      'xlWorkBooks.Close
                      'xlApp.Quit
                      End Sub
                      

                       

                      Everything seemed to be working, until it got to the If-Then statement.  It would go through the parts to see IF it would match the criteria by printing this:

                       

                      For Each Component

                      If Type False val, valout

                       

                      but it never returned this if true: Debug.Print "If valout Like Plate or Sheet Then".

                       

                      I then put the "Type" property on the Custom tab instead of Configuration Specific on several parts but that didn't help.  So it looks like IF is being checked, but the THEN statement isn't working properly.