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



     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






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"


            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









End Sub