ds-blue-logo
Preview  |  SOLIDWORKS USER FORUM
Use your SOLIDWORKS ID or 3DEXPERIENCE ID to log in.
PFPaul Flores10/03/2015

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.