ds-blue-logo
Preview  |  SOLIDWORKS USER FORUM
Use your SOLIDWORKS ID or 3DEXPERIENCE ID to log in.
VPVincent Piazza10/07/2013

I have a macro that exports the mass properties of all of the parts in and assembly to excel. It seems to work alright on all of the parts, except those that do not have any mass properties. For those parts, they get the mass properties of the top most assembly. Is there a way I can ignore these parts which don't have any mass properties?

Here's a snippet of the code:

Sub SwExtractData()

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 RetVal As Long

Dim Description As String

'Get active drawing view

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

Set swAssembly = swModel

Set swModExt = swModel.Extension

Set MassProp = swModExt.CreateMassProperty

'Open Excel

OutputPath = Environ("USERPROFILE") & "\Desktop\"

OutputFN = swModel.GetTitle & ".xlsx"

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 = "Type"

xlsheet.Range("B1").value = "Part"

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

xlsheet.Range("D1").value = "Material"

xlsheet.Range("E1").value = "Volume"

xlsheet.Range("F1").value = "Surface Area"

xlsheet.Range("G1").value = ""

xlsheet.Range("H1").value = ""

xlsheet.Range("I1").value = "Weight"


'Set current row to 2

xlCurRow = 2

RetVal = swAssembly.ResolveAllLightWeightComponents(False)

Components = swAssembly.GetComponents(False)

On Error Resume Next

'Loop that populates excel spreadsheet

For Each Component In Components

    Set swComp = Component

        If swComp.GetSuppression <> 0 And Not swComp.IsHidden(False) Then

            Dim swModelComp As SldWorks.ModelDoc2

            Set swModelComp = swComp.GetModelDoc

            If swModelComp.GetType = swDocASSEMBLY Then

                Set MassProp = swModelComp.Extension.CreateMassProperty

            Else

                Set MassProp = swModExt.CreateMassProperty

            End If

           

            MassProp.UseSystemUnits = False 'Use document units

            Bodies = swComp.GetBodies2(swSolidBody And swSheetBody)

            RetBool = MassProp.AddBodies(Bodies)

            CenOfM = MassProp.CenterOfMass

            xlsheet.Range("B" & xlCurRow).value = swcomp.GetPathName

            xlsheet.Range("C" & xlCurRow).value = GetRefConfigProps(swComp, "Description")

            xlsheet.Range("D" & xlCurRow).value = GetDefaultPartProps(swComp, "Material")

            xlsheet.Range("E" & xlCurRow).value = Round(MassProp.Volume, 2)

            xlsheet.Range("F" & xlCurRow).value = Round(MassProp.SurfaceArea, 2)

            xlsheet.Range("I" & xlCurRow).value = Round(MassProp.Mass, 5)

            xlsheet.Range("K" & xlCurRow).value = Round(CenOfM(1), 5)

            xlsheet.Range("M" & xlCurRow).value = Round(CenOfM(2), 5)

            xlsheet.Range("P" & xlCurRow).value = Round(-(CenOfM(0)), 5)

        'Tests to see if last three letters in file name are asm or prt

            If LCase(Right(swComp.GetPathName, 3)) = "asm" Then

                    xlsheet.Range("A" & xlCurRow).value = "Assembly"

                ElseIf LCase(Right(swComp.GetPathName, 3)) = "prt" Then

                    xlsheet.Range("A" & xlCurRow).value = "Part"

                Else

                    xlsheet.Range("A" & xlCurRow).value = "ERROR IN MASS PROPS OUTPUT"

            End If 'Right 3 of file extension

    xlCurRow = xlCurRow + 1

    End If

Next Component

xlsheet.UsedRange.EntireColumn.AutoFit

End Sub