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