I'm exporting the mass properties from SW into Excel using a macro. I've recently run into the issue where the model builders are using cutlists rather than just individual parts. My macro is able to get the mass properties for the sum of the cutlist, but I need it to break it down into each individual piece and am at a lost on how to do it.
Any help would be appreciated. Here is the code. Others are welcome to it if they need to simply export the mass properties of an assembly to excel. Note: everything except the assembly you want infomation for must be suppressed.
*************************************************
Option Explicit
Public xlApp As Excel.Application
Public xlWorkBooks As Excel.Workbooks
Public xlBook As Excel.Workbook
Public xlsheet As Excel.Worksheet
Public OutputPath As String
Public OutputFN As String
Public xlCurRow As Integer
Sub main()
Call SwExtractData
'Call CondenseData
'saves, and quits excel
'xlBook.Save
'xlWorkBooks.Close
'xlApp.Quit
End Sub
'This subroutine opens excel, and populates the worksheet with various data from the respective parts
Sub SwExtractData()
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 RetVal As Long
Dim swFeat As IFeature
Dim Description As String
Dim path As String 'Used to get and edit the part name
Dim Name As String 'Used to get name of non-MPN parts
Dim refConf As String 'Gets the referenced configuration name
Dim extensionLen As Integer 'Used in editing name of parts
Dim Name2 As String 'Used to get name of MPN parts
'Get active drawing view
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Checks to see if various preconditions are met in order for the macro to run
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
'Open Excel
OutputPath = Environ("USERPROFILE") & "\Desktop\"
OutputFN = swModel.GetTitle & ".xlsx"
Set xlApp = Excel.Application
xlApp.Visible = True
Set xlWorkBooks = Excel.Workbooks
Set xlBook = xlWorkBooks.Add()
Set xlsheet = xlBook.Worksheets("Sheet1")
Sheets("Sheet2").Name = "A -Title"
'Populate Excel Spreadsheet Titles
xlsheet.Range("A1").value = "Type"
xlsheet.Range("B1").value = "Item"
xlsheet.Range("C1").value = "Part"
xlsheet.Range("D1").value = "Drawing No."
xlsheet.Range("E1").value = "E/C/A"
xlsheet.Range("F1").value = "Description"
xlsheet.Range("G1").value = "Material"
xlsheet.Range("H1").value = "Qty"
xlsheet.Range("I1").value = "Unit Weight (kg) "
xlsheet.Range("J1").value = "Total Weight (kg)"
xlsheet.Range("K1").value = "Removal"
xlsheet.Range("L1").value = "VCG (m)"
xlsheet.Range("M1").value = "V Moment (kg-m) "
xlsheet.Range("N1").value = "LCG (m)"
xlsheet.Range("O1").value = "L Moment (kg-m)"
xlsheet.Range("P1").value = "TCG (m)"
xlsheet.Range("Q1").value = "T Moment (kg-m)"
xlsheet.Range("R1").value = "P/S"
'Highlights columns
Worksheets("sheet1").Range("C:C").Interior.Color = RGB(216, 216, 216)
Worksheets("sheet1").Range("E:E").Interior.Color = RGB(216, 216, 216)
Worksheets("sheet1").Range("G:G").Interior.Color = RGB(216, 216, 216)
Worksheets("sheet1").Range("J:J").Interior.Color = RGB(216, 216, 216)
Worksheets("sheet1").Range("L:L").Interior.Color = RGB(216, 216, 216)
Worksheets("sheet1").Range("N:N").Interior.Color = RGB(216, 216, 216)
Worksheets("sheet1").Range("P:P").Interior.Color = RGB(216, 216, 216)
'Highlights title row
ActiveSheet.Rows("1").Interior.Color = RGB(155, 187, 89)
'Freezes top title row
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
'Set current row to 2
xlCurRow = 2
'RetVal = swAssembly.ResolveAllLightWeightComponents(False)
Components = swAssembly.GetComponents(0)
'On Error Resume Next
'Loop that populates excel spreadsheet
For Each Component In Components
Set swComp = Component
If swComp.GetSuppression <> 0 And Not swComp.IsHidden(False) Then
Bodies = swComp.GetBodies2(0)
RetBool = MassProp.AddBodies(Bodies)
CenOfM = MassProp.CenterOfMass
path = swComp.GetPathName 'Grabs whole path name of part to later be edited
extensionLen = Len(".sldxxx") 'Used to get the part name (meant to exclude the part extension from name
Name = Mid(path, InStrRev(path, "\") + 1, Len(path) - InStrRev(path, "\") - extensionLen)
refConf = Mid(swComp.ReferencedConfiguration, 1, 4) 'Used to get the referenced configuration name
'Logic that determines if "MPN" is in the part name, and if so it adds the referenced configuration to the end
If InStr(Name, "MPN") Then
Name2 = Name + refConf
Else: Name2 = Name
End If
'Logic to see if each of the different MPN numbers are in string, and if so it deletes them
If InStr(Name, "-MPN01") Then
Name2 = Replace(Name, "-MPN01", "") + refConf
ElseIf InStr(Name, "-MPN02") Then
Name2 = Replace(Name, "-MPN02", "") + refConf
ElseIf InStr(Name, "-MPN03") Then
Name2 = Replace(Name, "-MPN03", "") + refConf
ElseIf InStr(Name, "-MPN04") Then
Name2 = Replace(Name, "-MPN04", "") + refConf
End If
'Logic to determine if ICD is in part name, and if so, highlights it (so that way we know to disregard this in spreadsheet)
If InStr(swComp.GetPathName, "ICD") Then
ActiveSheet.Rows(xlCurRow).Interior.Color = RGB(255, 255, 153)
End If
'Tests to see if last three (lowercase) letters in file name are asm or prt
If LCase(Right(swComp.GetPathName, 3)) = "asm" Then
xlsheet.Range("A" & xlCurRow).value = "Assembly"
ElseIf LCase(Right(swComp.GetPathName, 3)) = "prt" Then
xlsheet.Range("A" & xlCurRow).value = "Part"
Else
xlsheet.Range("A" & xlCurRow).value = "ERROR IN MASS PROPS OUTPUT"
End If 'Right 3 of file extension
'Highlights row is "error in mass props is found"
If xlsheet.Range("A" & xlCurRow).value = "ERROR IN MASS PROPS OUTPUT" Then
ActiveSheet.Rows(xlCurRow).Interior.Color = RGB(217, 151, 149)
End If
'Tests to see if last three (uppercase) letters in file name are asm or prt
If UCase(Right(swComp.GetPathName, 3)) = "ASM" Then
xlsheet.Range("A" & xlCurRow).value = "Assembly"
ElseIf UCase(Right(swComp.GetPathName, 3)) = "PRT" Then
xlsheet.Range("A" & xlCurRow).value = "Part"
Else
xlsheet.Range("A" & xlCurRow).value = "ERROR IN MASS PROPS OUTPUT"
End If 'Right 3 of file extension
xlsheet.Range("C" & xlCurRow).value = Name2
xlsheet.Range("D" & xlCurRow).value = "='A -Title'!\$Q\$5 "
'xlsheet.Range("E" & xlCurRow).valbecue = E/C/A
xlsheet.Range("F" & xlCurRow).value = GetRefConfigProps(swComp, "Description")
'This If statement is meant to get the default description if if couldn't get an referenced configuration description
If xlsheet.Range("F" & xlCurRow).value = "" Then
xlsheet.Range("F" & xlCurRow).value = GetDefaultPartProps(swComp, "Description")
End If
xlsheet.Range("G" & xlCurRow).value = GetDefaultPartProps(swComp, "Material")
xlsheet.Range("H" & xlCurRow).value = 1 'Qty of 1 which is what we're currently using for the parts we get
'Doesn't get data for current row if it is an assembly (as assembly data is inaccurate)
If UCase(Right(swComp.GetPathName, 3)) = "ASM" Or xlsheet.Range("A" & xlCurRow).value = "ERROR IN MASS PROPS OUTPUT" Then
xlsheet.Range("I" & xlCurRow) = ""
Else: xlsheet.Range("I" & xlCurRow).value = MassProp.Mass
End If
'Doesn't get data for current row if it is an assembly (as assembly data is inaccurate)
If UCase(Right(swComp.GetPathName, 3)) = "ASM" Or xlsheet.Range("A" & xlCurRow).value = "ERROR IN MASS PROPS OUTPUT" Then
xlsheet.Range("J" & xlCurRow) = ""
Else: xlsheet.Range("J" & xlCurRow).value = xlsheet.Range("H" & xlCurRow).value * xlsheet.Range("I" & xlCurRow).value '(Mass * Qty).
End If
xlsheet.Range("K" & xlCurRow).value = "" 'Nothing here for removal
'Doesn't get data for current row if it is an assembly (as assembly data is inaccurate)
If UCase(Right(swComp.GetPathName, 3)) = "ASM" Or xlsheet.Range("A" & xlCurRow).value = "ERROR IN MASS PROPS OUTPUT" Then
xlsheet.Range("L" & xlCurRow) = ""
Else: xlsheet.Range("L" & xlCurRow).value = CenOfM(1) 'VCG
End If
xlsheet.Range("M" & xlCurRow).value = (xlsheet.Range("J" & xlCurRow).value + xlsheet.Range("K" & xlCurRow).value) * xlsheet.Range("L" & xlCurRow).value '(Total mass + Removal) * VCG
'Doesn't get data for current row if it is an assembly (as assembly data is inaccurate)
If UCase(Right(swComp.GetPathName, 3)) = "ASM" Or xlsheet.Range("A" & xlCurRow).value = "ERROR IN MASS PROPS OUTPUT" Then
xlsheet.Range("N" & xlCurRow) = ""
Else: xlsheet.Range("N" & xlCurRow).value = CenOfM(2) 'LCG
End If
'PLACEHOLDER FOR LCG SIGN (N)
xlsheet.Range("O" & xlCurRow).value = (xlsheet.Range("J" & xlCurRow).value + xlsheet.Range("K" & xlCurRow).value) * xlsheet.Range("N" & xlCurRow).value '(Total mass + Removal) * LCG
'Doesn't get data for current row if it is an assembly (as assembly data is inaccurate)
If UCase(Right(swComp.GetPathName, 3)) = "ASM" Or xlsheet.Range("A" & xlCurRow).value = "ERROR IN MASS PROPS OUTPUT" Then
xlsheet.Range("P" & xlCurRow) = ""
Else: xlsheet.Range("P" & xlCurRow).value = -(CenOfM(0)) 'TCG
End If
xlsheet.Range("Q" & xlCurRow).value = (xlsheet.Range("J" & xlCurRow).value + xlsheet.Range("K" & xlCurRow).value) * xlsheet.Range("P" & xlCurRow).value '(Total mass + Removal) * TCG
'PLACEHOLDER FOR P/S (TCG Sign)
'xlsheet.Range("S" & xlCurRow).value = EFF
'xlsheet.Range("T" & xlCurRow).value = SWBS CODE
'Checks sign of TCG and outputs based on negative or positive value
If xlsheet.Range("P" & xlCurRow).value < 0 Then
xlsheet.Range("R" & xlCurRow).value = "S"
ElseIf xlsheet.Range("P" & xlCurRow).value > 0 Then
xlsheet.Range("R" & xlCurRow).value = "P"
End If
'If current row is an assembly, the row is highlighted
If xlsheet.Range("A" & xlCurRow).value = "Assembly" Then
ActiveSheet.Rows(xlCurRow).Interior.Color = RGB(149, 179, 215)
End If
xlCurRow = xlCurRow + 1
End If
Next Component
'This portion of the code creates the totals section
xlsheet.Range("F" & xlCurRow + 3).value = "Hardware Allowance"
xlsheet.Range("F" & xlCurRow + 5).value = "Stbd Assembly"
xlsheet.Range("F" & xlCurRow + 6).value = "Port Assembly"
xlsheet.Range("F" & xlCurRow + 7).value = "Welding Allowance Stbd"
xlsheet.Range("F" & xlCurRow + 8).value = "Welding Allowance Port"
xlsheet.Range("F" & xlCurRow + 10).value = "Total Calculated Weight Addition"
xlsheet.Range("F" & xlCurRow + 11).value = "Total Calculated Weight Removal"
xlsheet.Range("F" & xlCurRow + 12).value = "Weight and Moment Summary"
'Provides total for weight
xlsheet.Range("J" & (xlCurRow + 5)).value = "=SUMIF(R2:R" & xlCurRow & "," & Chr(34) & "P" & Chr(34) & ", J2:J" & xlCurRow & ")" 'xlApp.WorksheetFunction.SumIf(xlsheet.Range("R2", "R" & xlCurRow), "S", xlsheet.Range("I2", "I" & xlCurRow))
xlsheet.Range("J" & (xlCurRow + 6)).value = "=SUMIF(R2:R" & xlCurRow & "," & Chr(34) & "S" & Chr(34) & ", J2:J" & xlCurRow & ")" 'xlApp.WorksheetFunction.SumIf(xlsheet.Range("R2", "R" & xlCurRow), "P", xlsheet.Range("I2", "I" & xlCurRow))
'Provides total for V moment
xlsheet.Range("M" & (xlCurRow + 5)).value = "=SUMIF(R2:R" & xlCurRow & "," & Chr(34) & "P" & Chr(34) & ", M2:M" & xlCurRow & ")" 'xlApp.WorksheetFunction.SumIf(xlsheet.Range("R2", "R" & xlCurRow), "S", xlsheet.Range("L2", "L" & xlCurRow))
xlsheet.Range("M" & (xlCurRow + 6)).value = "=SUMIF(R2:R" & xlCurRow & "," & Chr(34) & "S" & Chr(34) & ", M2:M" & xlCurRow & ")" 'xlApp.WorksheetFunction.SumIf(xlsheet.Range("R2", "R" & xlCurRow), "P", xlsheet.Range("L2", "L" & xlCurRow))
'Provides total for VCG
xlsheet.Range("L" & (xlCurRow + 5)).value = "=J" & (xlCurRow + 5) & "/M" & (xlCurRow + 5) 'xlsheet.Range("I" & (xlCurRow + 4)).value / xlsheet.Range("L" & (xlCurRow + 5)).value
xlsheet.Range("L" & (xlCurRow + 6)).value = "=J" & (xlCurRow + 6) & "/M" & (xlCurRow + 6) 'xlsheet.Range("I" & (xlCurRow + 5)).value / xlsheet.Range("L" & (xlCurRow + 6)).value
'Provides total for L moment
xlsheet.Range("O" & (xlCurRow + 5)).value = "=SUMIF(R2:R" & xlCurRow & "," & Chr(34) & "P" & Chr(34) & ", O2:O" & xlCurRow & ")" ' xlApp.WorksheetFunction.SumIf(xlsheet.Range("R2", "R" & xlCurRow), "S", xlsheet.Range("O2", "O" & xlCurRow))
xlsheet.Range("O" & (xlCurRow + 6)).value = "=SUMIF(R2:R" & xlCurRow & "," & Chr(34) & "S" & Chr(34) & ", O2:O" & xlCurRow & ")" ' xlApp.WorksheetFunction.SumIf(xlsheet.Range("R2", "R" & xlCurRow), "P", xlsheet.Range("O2", "O" & xlCurRow))
'Provides total for LCG
xlsheet.Range("N" & (xlCurRow + 5)).value = "=J" & (xlCurRow + 5) & "/O" & (xlCurRow + 5) 'xlsheet.Range("I" & (xlCurRow + 4)).value / xlsheet.Range("O" & (xlCurRow + 5)).value
xlsheet.Range("N" & (xlCurRow + 6)).value = "=J" & (xlCurRow + 6) & "/O" & (xlCurRow + 6) 'xlsheet.Range("I" & (xlCurRow + 5)).value / xlsheet.Range("O" & (xlCurRow + 6)).value
'Provides total for T moment
xlsheet.Range("Q" & (xlCurRow + 5)).value = "=SUMIF(R2:R" & xlCurRow & "," & Chr(34) & "P" & Chr(34) & ", Q2:Q" & xlCurRow & ")" 'xlApp.WorksheetFunction.SumIf(xlsheet.Range("R2", "R" & xlCurRow), "S", xlsheet.Range("Q2", "Q" & xlCurRow))
xlsheet.Range("Q" & (xlCurRow + 6)).value = "=SUMIF(R2:R" & xlCurRow & "," & Chr(34) & "S" & Chr(34) & ", Q2:Q" & xlCurRow & ")" 'xlApp.WorksheetFunction.SumIf(xlsheet.Range("R2", "R" & xlCurRow), "P", xlsheet.Range("Q2", "Q" & xlCurRow))
'Provides total for TCG
xlsheet.Range("P" & (xlCurRow + 5)).value = "=J" & (xlCurRow + 5) & "/Q" & (xlCurRow + 5) 'xlsheet.Range("I" & (xlCurRow + 4)).value / xlsheet.Range("Q" & (xlCurRow + 5)).value
xlsheet.Range("P" & (xlCurRow + 6)).value = "=J" & (xlCurRow + 6) & "/Q" & (xlCurRow + 6) 'xlsheet.Range("I" & (xlCurRow + 5)).value / xlsheet.Range("Q" & (xlCurRow + 6)).value
'Total TCG Sign
If xlsheet.Range("P" & xlCurRow + 5).value < 0 Then
xlsheet.Range("R" & xlCurRow + 5).value = "S"
ElseIf xlsheet.Range("P" & xlCurRow + 5).value > 0 Then
xlsheet.Range("R" & xlCurRow + 5).value = "P"
End If
If xlsheet.Range("P" & xlCurRow + 6).value < 0 Then
xlsheet.Range("R" & xlCurRow + 6).value = "S"
ElseIf xlsheet.Range("P" & xlCurRow + 6).value > 0 Then
xlsheet.Range("R" & xlCurRow + 6).value = "P"
End If
'Hardware allowance calculation
xlsheet.Range("J" & xlCurRow + 3).value = "=H" & (xlCurRow + 3) & "*sum(J2:J" & xlCurRow & ")"
'Welding Allowance Stbd and Port calculation
xlsheet.Range("J" & xlCurRow + 7).value = "=H" & (xlCurRow + 7) & "*sumif(R2:R" & xlCurRow & "," & Chr(34) & "S" & Chr(34) & ",J2:J" & xlCurRow & ")" 'Note, Chr(34) used here because can't put double quotes within string, so it's used as a workaround
xlsheet.Range("J" & xlCurRow + 8).value = "=H" & (xlCurRow + 8) & "*sumif(R2:R" & xlCurRow & "," & Chr(34) & "P" & Chr(34) & ",J2:J" & xlCurRow & ")"
'V Moment for welding allowance
xlsheet.Range("M" & xlCurRow + 7).value = "=M" & (xlCurRow + 5) & "*H" & (xlCurRow + 7)
xlsheet.Range("M" & xlCurRow + 8).value = "=M" & (xlCurRow + 6) & "*H" & (xlCurRow + 8)
'VCG for welding allowance
xlsheet.Range("L" & xlCurRow + 7).value = "=M" & (xlCurRow + 7) & "/J" & (xlCurRow + 7)
xlsheet.Range("L" & xlCurRow + 8).value = "=M" & (xlCurRow + 8) & "/J" & (xlCurRow + 8)
'L Moment for welding allowance
xlsheet.Range("O" & xlCurRow + 7).value = "=O" & (xlCurRow + 5) & "*H" & (xlCurRow + 7)
xlsheet.Range("O" & xlCurRow + 8).value = "=O" & (xlCurRow + 6) & "*H" & (xlCurRow + 8)
'LCG for welding allowance
xlsheet.Range("N" & xlCurRow + 7).value = "=O" & (xlCurRow + 7) & "/J" & (xlCurRow + 7)
xlsheet.Range("N" & xlCurRow + 8).value = "=O" & (xlCurRow + 8) & "/J" & (xlCurRow + 8)
'T Moment for welding allowance
xlsheet.Range("Q" & xlCurRow + 7).value = "=Q" & (xlCurRow + 5) & "*H" & (xlCurRow + 7)
xlsheet.Range("Q" & xlCurRow + 8).value = "=Q" & (xlCurRow + 6) & "*H" & (xlCurRow + 8)
'TCG for welding allowance
xlsheet.Range("P" & xlCurRow + 7).value = "=Q" & (xlCurRow + 7) & "/J" & (xlCurRow + 7)
xlsheet.Range("P" & xlCurRow + 8).value = "=Q" & (xlCurRow + 8) & "/J" & (xlCurRow + 8)
'Grand Total calculations
'Total weight
xlsheet.Range("J" & xlCurRow + 10).value = "=sum(J" & (xlCurRow + 3) & ":J" & (xlCurRow + 8)
'Removal
xlsheet.Range("K" & xlCurRow + 11).value = "=sum(K" & (xlCurRow + 3) & ":K" & (xlCurRow + 8)
'Grand total weight (taking into account removal)
xlsheet.Range("J" & xlCurRow + 12).value = "=J" & (xlCurRow + 10) & "+K" & (xlCurRow + 11)
'xlsheet.Range("J" & xlCurRow + 12).value = "=sum(J" & (xlCurRow + 11) & ":J" & (xlCurRow + 7) & ")"
'V Moment
xlsheet.Range("M" & xlCurRow + 12).value = "=sum(M" & (xlCurRow + 3) & ":M" & (xlCurRow + 11) & ")"
'VCG
xlsheet.Range("L" & xlCurRow + 12).value = "=M" & (xlCurRow + 12) & "/J" & (xlCurRow + 12)
'L Moment
xlsheet.Range("O" & xlCurRow + 12).value = "=sum(O" & (xlCurRow + 3) & ":O" & (xlCurRow + 11) & ")"
'LCG
xlsheet.Range("N" & xlCurRow + 12).value = "=O" & (xlCurRow + 12) & "/J" & (xlCurRow + 12)
'T Moment
xlsheet.Range("Q" & xlCurRow + 12).value = "=sum(Q" & (xlCurRow + 3) & ":Q" & (xlCurRow + 11) & ")"
'TCG
xlsheet.Range("P" & xlCurRow + 12).value = "=Q" & (xlCurRow + 12) & "/J" & (xlCurRow + 12)
'P/S
If xlsheet.Range("P" & xlCurRow + 12).value < 0 Then
xlsheet.Range("R" & xlCurRow + 12).value = "S"
ElseIf xlsheet.Range("P" & xlCurRow + 12).value > 0 Then
xlsheet.Range("R" & xlCurRow + 12).value = "P"
End If
xlsheet.UsedRange.EntireColumn.AutoFit
'Checks type column to see if "ERROR IN MASS PROPS" appears, and if it does, warns user
'If xlsheet.Range("A1", "A" & xlCurRow).value = "Part" Then '"ERROR IN MASS PROPS OUTPUT" Then
'MsgBox ("Warning, ERROR IN MASS PROPS OUTPUT detected in output. Please refer to that section in the Read-Me for instructions on how to fix the issue.")
'End If
End Sub
'This function is used to get access to the custom property manager in order to get the part description, number, etc. to be used in the subroutine SwExtractData
Private Function GetDefaultPartProps(swComp As Component2, swProp As String) As String
Dim myDoc As ModelDoc2
Dim sa As Variant
Dim i As Integer
Dim myVal As String
Dim myValOut As String
Dim myMgr As ICustomPropertyManager
Dim retB As Boolean
Dim refConfigName As String
refConfigName = swComp.ReferencedConfiguration
Set myDoc = swComp.GetModelDoc2
If myDoc Is Nothing Then Exit Function 'This will happen if you load your assembly lightweight
Set myMgr = myDoc.Extension.CustomPropertyManager(refConfigName)
GetDefaultPartProps = ""
sa = myMgr.GetNames
If IsEmpty(sa) Then Exit Function
For i = 0 To UBound(sa)
If sa(i) = swProp Then
retB = myMgr.Get4(sa(i), False, myVal, myValOut)
GetDefaultPartProps = myValOut
Exit Function
End If
Next
End Function
'This function is used in conjunction with the function GetCustomProperty. GetRefConfigProps gets the referenced configuration description, while
'GetDefaultPartProps gets the default part description
Private Function GetRefConfigProps(swComp As Component2, swProp As String) As String
Dim myDoc As ModelDoc2
Dim sa As Variant
Dim i As Integer
Dim myVal As String
Dim myValOut As String
Dim myMgr As ICustomPropertyManager
Dim retB As Boolean
Dim refConfigName As String
refConfigName = swComp.ReferencedConfiguration
Set myDoc = swComp.GetModelDoc2
If myDoc Is Nothing Then Exit Function 'This will happen if you load your assembly lightweight
Set myMgr = myDoc.Extension.CustomPropertyManager("")
GetRefConfigProps = ""
sa = myMgr.GetNames
If IsEmpty(sa) Then Exit Function
For i = 0 To UBound(sa)
If sa(i) = swProp Then
retB = myMgr.Get4(sa(i), False, myVal, myValOut)
GetRefConfigProps = myValOut
Exit Function
End If
Next
End Function
'This subroutine will condense the data by assembly and then type, and sum various data for the respective types
'Sub CondenseData()
'End Sub
**********************************************************
SolidworksApi macros