2 Replies Latest reply on Jan 18, 2018 8:49 AM by Edgars Baumanis

    exporting part dimensions to excel file

    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?

        • Re: exporting part dimensions to excel file
          Attilio Colangelo

          GetPartBox is a method on IPartDoc. Your SwModel is an IAssemblyDoc when you get to GetPartBox.

          However, within your For Each Component loop you can get the IPartDoc from the current component as follows:

           

          Set SwPart = SwComp.GetModelDoc2 'This will return a PartDoc

          SolidWorksPartCorners = SwPart.GetPartBox(True) 'This will get the bounding box for the part

           

            • Re: exporting part dimensions to excel file
              Edgars Baumanis

              Hello!

               

              Thank you for your reply. I got everything working. Now I can read file dimensions, I also have added script that transforms bended part into flatten form before reading dimensions (so I know what kind of material and how much I will need).

               

              Now there are two problems:

               

              1) It returns all parts from assembly, also screws and other parts like that. Is it possible to somehow check only sheet metal parts? The problem is that some "sheet metal" parts which are not bended, but simple plate with some holes maybe, are made by Base extrude function and they are not made by sheet metal function. That is why I cannot figure out a way to distinguish "sheet metal" parts from other parts.

               

              2) The second problem is that "thickness" value I get returned in different columns in my excel table. Basically I have width, length and height. Width and length order is not so important, because they will be used later for calculating square meters. Thickness, however, is important that it should be in the same column all the time, because in the end I need to know how many square meters of what thickness material I will need.

              I think this problem might occur, that for different parts designer has chosen different planes on which they start building part. That is why my script reads sometimes thickness value as length or width.

               

              wrong_column.png

               

              Can somebody help with these problems?

               

              Here is the script that I have edited and sticked together from what I have found on the Internet. It might not be the best solution and cleanest code, but so far it works (except those two problems).

               

               

              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

               

               

              Public swPart As Object

              Dim SolidWorksPartCorners As Variant

               

              Option Explicit

               

               

              ''' variables for part flattening script

               

              Public Enum swSMBendState_e

               

                  swSMBendStateNone = 0       '  No bend state - not a sheet metal part

               

                  swSMBendStateSharps = 1     '  Bends are in the sharp state - bends currently not applied

               

                  swSMBendStateFlattened = 2  '  Bends are flattened

               

                  swSMBendStateFolded = 3     '  Bends are fully applied

               

              End Enum

               

              Public Enum swSMCommandStatus_e

               

                  swSMErrorNone = 0               '  No errors

               

                  swSMErrorUnknown = 1            '  Failed for an unknown reason

               

                  swSMErrorNotAPart = 2           '  Sheet metal commands only apply to SolidWorks parts

               

                  swSMErrorNotASheetMetalPart = 3 '  Part contains no sheet metal features

               

                  swSMErrorInvalidBendState = 4   '  Invalid bend state was specified

               

              End Enum

               

               

               

               

                  Dim nBendState          As Long

               

                  Dim nRetVal             As Long

               

                  Dim bRet                As Boolean

              '' end of variables

                 

                 

              '' variables for part dimensions

              Dim SolidWorksPartLength As Double

              Dim SolidWorksPartWidth As Double

              Dim SolidWorksPartHeight As Double

                 

                  

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

               

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

               

              xlsheet.Range("D1").Value = "Height"

               

              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)

               

               

                      'If Bodies <> Empty Then

               

                          RetBool = MassProp.AddBodies(Bodies)

                        

                        

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

               

                          xlsheet.Range("F" & xlCurRow).Value = "Assembly"

                         

               

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

                         

                         

                         

                  Set swPart = SwComp.GetModelDoc2 'This will return a PartDoc

               

               

              '''''''''''' flatten bended part, so it can read real metal sheet dimensions

               

               

                  nBendState = swPart.GetBendState

               

                 

               

                  Debug.Print "File = " & swPart.GetPathName

               

                  Debug.Print "  BendState    = " & nBendState

               

                 

               

                  If nBendState <> swSMBendStateFlattened Then

               

                      nRetVal = swPart.SetBendState(swSMBendStateFlattened)

               

                      Debug.Print "  SetBendState = " & nRetVal

               

                     

               

                      ' Rebuild to see changes

               

                      bRet = swPart.EditRebuild3: Debug.Assert bRet

               

                  End If

                     

              ''''''''''' end of flattening part ''''''

                         

               

                 

                  SolidWorksPartCorners = swPart.GetPartBox(True) 'This will get the bounding box for the part

                 

                  SolidWorksPartLength = Abs(SolidWorksPartCorners(3) - SolidWorksPartCorners(0)) * 1000 'X axis length in meters

                  SolidWorksPartWidth = Abs(SolidWorksPartCorners(4) - SolidWorksPartCorners(1)) * 1000 ' Y axis length in meters

                  SolidWorksPartHeight = Abs(SolidWorksPartCorners(5) - SolidWorksPartCorners(2)) * 1000 ' Z axis length in meters

                 

               

               

               

                          xlsheet.Range("F" & xlCurRow).Value = "Part"

               

                          Else

               

                          xlsheet.Range("F" & xlCurRow).Value = "Undetermined"

               

                          End If 'Right 3 of file extension

                        

                        

               

                          xlsheet.Range("A" & xlCurRow).Value = SwComp.Name

               

                          xlsheet.Range("B" & xlCurRow).Value = SolidWorksPartLength

                         

                          xlsheet.Range("C" & xlCurRow).Value = SolidWorksPartWidth

               

                          xlsheet.Range("D" & xlCurRow).Value = SolidWorksPartHeight

               

                          xlsheet.Range("E" & xlCurRow).Value = MassProp.Mass

               

                                         

               

                         

               

                        

               

                          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

               

              End Sub