The purpose of this macro is to be able to select multiple surfaces from an assembly, and print out (to excel) the Area and Area Moment of Inertia (Ixx,Iyy,Izz) for each individual surface selected. For example, selecting both surfaces below with cursor, running the macro, and printing to excel each surface's respective Area, Ixx, Iyy, and Izz:

The code below works for one surface, but when multiple surfaces are selected, the macro is unable to distinguish between each individual surface, combines them, and outputs as if one selection was made. Any thoughts?

'Pre-conditions:

'Select surfaces before running macro

'Selection must be a surface

Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim xlApp As Excel.Application

Dim xlBook As Excel.Workbook

Dim xlSheet As Excel.Worksheet

Dim FirstRow As Long

Dim FirstCol As Long

Dim Area As Long

Dim XVal As Long

Dim YVal As Long

Dim ZVal As Long

Dim AMOIxx As Long

Dim AMOIyy As Long

Dim AMOIzz As Long

Dim vComps As Variant

Dim i As Integer

Dim Message1 As String

Dim Message2 As String

Dim swModelExt As SldWorks.ModelDocExtension

Dim swSelMgr As SldWorks.SelectionMgr

Dim swFeat() As SldWorks.Feature

Dim swFaceEnt() As SldWorks.Entity

Dim swSketch As SldWorks.Sketch

Dim nSelType As Long

Dim swSelObj() As Object

Dim vSelObj As Variant

Dim vSectionProp As Variant

Dim nSelCount As Integer

Dim nNumObj As Long

Dim nFeatureArr() As Variant

Sub main()

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

Set swModelExt = swModel.Extension

Set swSelMgr = swModel.SelectionManager

'CONFIRM AN ASSEMBLY DOC IS OPEN

If swModel Is Nothing Then

swApp.SendMsgToUser2 "An Assembly document must be open as the active document(Error Code:1).", swMbWarning, swMbOk

Exit Sub

ElseIf swModel.GetType <> swDocASSEMBLY Then

swApp.SendMsgToUser2 "An Assembly document must be open as the active document(Error Code:2).", swMbWarning, swMbOk

Exit Sub

Else

Message1 = "Assembly file confirmed!"

swApp.SendMsgToUser2 Message1, 2, 2 'first 2 = "ok option", second 2 = display info icon

End If

'CONFIRM AT LEAST ONE SELECTION IS MADE

nSelCount = swSelMgr.GetSelectedObjectCount

Debug.Print "Selected Count: " & nSelCount

If nSelCount = 0 Then

swApp.SendMsgToUser2 "You must make a selection before running the macro (Error Code:2).", swMbWarning, swMbOk

Exit Sub

Else

Message2 = "Number of Selections: " & nSelCount

swApp.SendMsgToUser2 Message2, 2, 2 'first 2 = "ok option", second 2 = display info icon

End If

'EXCEL PAGE SETUP

Set xlApp = CreateObject("Excel.Application")

xlApp.Visible = True 'Display the created workbook

Set xlBook = xlApp.Workbooks.Add 'Create a new workbook

Set xlSheet = xlBook.Worksheets("Sheet1") 'Define which worksheet to use within the workbook

FirstRow = 1

FirstCol = 1

Area = FirstCol + 1

AMOIxx = FirstCol + 2

AMOIyy = FirstCol + 3

AMOIzz = FirstCol + 4

FilePath = swModel.GetPathName 'Defining file Path (to use to print to excel)

Debug.Print "FilePath: " & FilePath

FileName = swModel.GetTitle 'Defining file Name (to use to print to excel)

Debug.Print "FileName: " & FileName

'Labels for excel print out

xlSheet.Cells(FirstRow + 1, FirstCol).value = FileName

xlSheet.Cells(FirstRow + 2, FirstCol).value = "Config #"

xlSheet.Cells(FirstRow + 1, Area).value = "Area"

xlSheet.Cells(FirstRow + 2, Area).value = "mm^2"

xlSheet.Cells(FirstRow + 1, AMOIxx).value = "AMOI xx"

xlSheet.Cells(FirstRow + 2, AMOIxx).value = "mm^4"

xlSheet.Cells(FirstRow + 1, AMOIyy).value = "AMOI yy"

xlSheet.Cells(FirstRow + 2, AMOIyy).value = "mm^4"

xlSheet.Cells(FirstRow + 1, AMOIzz).value = "AMOI zz"

xlSheet.Cells(FirstRow + 2, AMOIzz).value = "mm^4"

FirstRow = FirstRow + 3 'start data on row 4

'ACCESSING/READING SOLIDWORKS SURFACE

Dim swFace() As SldWorks.Face2

ReDim Preserve swFace(nSelCount - 1) 're-dimension array to have as many cells as there are selections

For i = 1 To nSelCount

Debug.Print "i: " & i

Set swFace(i - 1) = swSelMgr.GetSelectedObject5(i)

nSelType = swSelMgr.GetSelectedObjectType2(i)

Debug.Print "Selection Type: " & nSelType

nNumObj = nNumObj + 1

Debug.Print "nNumObj: " & nNumObj

ReDim Preserve swSelObj(nNumObj - 1)

ReDim Preserve swFaceEnt(nNumObj - 1)

Set swComponent = swFace(i - 1).GetComponent 'used to get the component name for excel printout

Set swFaceEnt(nNumObj - 1) = swFace(i - 1)

Set swSelObj(nNumObj - 1) = swFace(i - 1)

'Deselect faces and sketches; otherwise, user-interface selections are added to array parameter; leave section faces selected

If Not IsEmpty(swFaceEnt) Then

Debug.Print "Are we here?"

For k = 0 To UBound(swFaceEnt)

swFaceEnt(k).DeSelect

Next k

End If

'

If Not IsEmpty(swFeat) Then

Debug.Print "Are we also here?"

For k = 0 To UBound(swFeat)

swFeat(k).DeSelect

Next k

End If

'This adds the array of faces or sketches to the selection set because the faces or sketches have been deselected, this preserves the selection set

vSelObj = swSelObj

vSectionProp = swModelExt.GetSectionProperties((vSelObj))

' Return code from: IModelDocExtension::GetSectionProperties

' 0 = success

' 1 = invalid input

' 2 = selected faces are not in the same or parallel planes

' 3 = unable to compute section properties

Debug.Print " Return code: " & vSectionProp(0)

'Print values in excel for each selection

xlSheet.Cells(FirstRow, FirstCol).value = swComponent.GetSelectByIDString

xlSheet.Cells(FirstRow, Area).value = vSectionProp(1) * 1000000#

xlSheet.Cells(FirstRow, AMOIxx).value = vSectionProp(5) * 1000000000000#

xlSheet.Cells(FirstRow, AMOIyy).value = vSectionProp(6) * 1000000000000#

xlSheet.Cells(FirstRow, AMOIzz).value = vSectionProp(7) * 1000000000000#

FirstRow = FirstRow + 1

Debug.Print "Next Empty Row: " & FirstRow

Debug.Print "Area: " & vSectionProp(1) * 1000000#

xlSheet.UsedRange.EntireColumn.AutoFit 'Resize cells to fit all info

Next i

xlSheet.Cells(1, FirstCol).value = FilePath 'print pathname (without resizing cell)

End Sub