AnsweredAssumed Answered

Trouble Exporting Part Desc. to Excel With Macro

Question asked by Vincent Piazza on May 24, 2013
Latest reply on May 24, 2013 by Vincent Piazza

Hello,

 

     As the title says, I'm having trouble getting the description for various parts and assemblies and adding them to my excel sheet. I'm actually using a macro that I found on these forums (but modified a little) to export mass, COMs, density, etc. But due to my limited programming skills, I'm having trouble getting access to IFeature in the loop I'm using to get the description, created by, etc. If someone could help me out and point me in the right direction that would be much appreciated. Thanks.

 

The error I am getting is the object variable or with block variable not set on the swFeat.Description line.

 

 

Here is the code I have so Far:

 

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

 

 

'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")

 

 

 

 

'Populate Excel Spreadsheet Titles

 

 

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

xlsheet.Range("B1").value = "LCG  (m)"

xlsheet.Range("C1").value = "TCG (m)"

xlsheet.Range("D1").value = "VCG (m)"

xlsheet.Range("E1").value = "Mass (kg)"

xlsheet.Range("F1").value = "Volume (m^3)"

xlsheet.Range("G1").value = "Density (kg/m^3)"

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

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

xlsheet.Range("J1").value = "Path"

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

 

 

'xlBook.SaveAs OutputPath & OutputFN

 

 

'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 = CenOfM(2)

            xlsheet.Range("C" & xlCurRow).value = -(CenOfM(0))

            xlsheet.Range("D" & xlCurRow).value = CenOfM(1)

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

            xlsheet.Range("F" & xlCurRow).value = MassProp.Volume

            xlsheet.Range("G" & xlCurRow).value = MassProp.Density

            xlsheet.Range("H" & xlCurRow).value = swComp.GetMaterialIdName

            xlsheet.Range("J" & xlCurRow).value = swComp.GetPathName

            xlsheet.Range("K" & x1CurRow).value = swFeat.Description

         

           

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

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

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

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

            Else

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

            End If 'Right 3 of file extension

            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

Outcomes