AnsweredAssumed Answered

exporting part dimensions to excel file

Question asked by Edgars Baumanis on Jan 13, 2018
Latest reply on Jan 18, 2018 by Edgars Baumanis

Hi!

 

I have found on the internet one macro that I would like to improve. It opens up assembly and exports each part weight. In the end I would like to get macro which opens up assembly, then reads dimensions of part and export that information to excel. Main purpose of that would be knowing how much of different metal sheet would be needed to make the parts from assembly. I understand that getpartbox function returns not so precise information, especially if that part has irregular shape. However, for me it is not so important, getpartbox function would be suitable for me.

 

Here is the original macro that I have found:

 

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 will remind that I am only beginner. I found the spot where macro start putting information into excel cells. I tried adding there this getpartbox function, but I get error. I cannot figure out why it does not like it. I get error "Object doesn' t support this property or method".

 

Here is "my edited" code

 

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

 

Dim SolidWorksPartCorners As Variant

 

 

 

 

 

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

           

           

           

           

                  SolidWorksPartCorners = SwModel.GetPartBox(True)

           

           

            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

 

 

 

 

 

Can you help me fix this problem, so I can continue editing this script?

Outcomes