SolidWorks一键生成BOM到Excel里，并可选择带缩略图

此前提到有粉丝朋友分享给我的一个VBA宏程序，能根据Solidworks装配体的零件属性一键导出到Excel，并可选择是否需要缩略图，零件的属性可以自定义，是一个很好的程序。但是试用后，发现有一些问题，其中最大的问题，也是很多粉丝朋友提到的一个问题，无法选择只导出子装配体或只导出子零件，它每次都把所有子装配体和所有子零件全部都导出来。还有一个问题是当装配体中含有轻化的零部件时，它会出错，无法正常运行。为此，我对该程序进行了改写，修正这些问题，并新增了一些实用功能，文末提供获取改进后的程序的方法。

改进后的程序界面如下图所示：

 

增加和修改的主要功能有以下这些：

1、允许用户选择是否显示子装配体及其子零件，当勾选“显示”时，子装配体及其子零件都显示，当勾选“隐藏”时，只显示子装配体，不显示其子零件，当勾选“提升”时，只显示子装配体内部各子零件，不显示子装配体本身，当勾选“自定义”时，则需要用户手工对每个子装配体进行设置，可以使每个子装配体的设置都不相同。如果同时勾选“更新配置”，则会把用户勾选的“显示”、“隐藏”、“提升”都设置到每一个装配体的对应配置里去。

2、增加了轻化零件可选择是否还原的功能，当检测到装配体中含有轻化装配体或零件时，会弹出提示框，询问用户是否将所有轻化装配体或零件还原，如果选择是，则自动将所有轻化的装配体及零件还原。如果选择否，则会把轻化装配体和零件当作被压缩的装配体或零件处理，BOM里不会出现它们的属性信息，但会在Excel表头里显示具体有多少个装配体或零件是轻化的。

3、增加“不同装配体中的相同零件分开列出”的选项，因为某些零件可能在不同的子装配体里重复出现，用户可以决定是否需要在BOM表里分开列出这些零件，如果选择不分开列出，那么这些零件的“所属装配号”对应的属性只能对应其中一个“所属装配号”。

4、增加了按属性排序的功能，并可选择“升序”、“降序”或“不排序”，但根装配体的属性不参与排序，根装配体始终位于BOM表的最前面。选择“不排序”时，子装配体后紧跟其对应的子零件。

5、使用WPS或Excel都可以适用程序，优先使用WPS。

6、质量属性设为固定属性，当质量小于10千克时，显示3位小数，当质量大于等于10千克小于100千克时，显示2位小数，当质量大于等于100千克小于1000千克时，显示1位小数，当质量大于等于1000千克时，不显示小数。

7、增加了“保存设置”按钮，用于保存用户的常用选项设置。

8、生成的Excel格式BOM默认保存在当前装配体相同路径下，与装配体的名称相同，可以选择更改保存的路径。

9、当切换活动装配体文档时，无须重新启动程序也可以直接导出新的活动装配体文档的BOM。

程序的总体设计思路是这样的：

1、首先采用递归的方法，遍历装配体中的所有零部件，检测是否有轻化的零件，如果检测到轻化的零件，则询问用户是否还原，如果用户选择还原，则进行还原，此步的具体代码如下：

'将轻化还原处理
Function resoveLightweight(ByVal Component As Object, ByVal level As Integer) As BooleanDim i           As IntegerDim Children    As VariantDim Child       As ObjectDim ChildCount  As IntegerIf resoveLightWeightConfirmed = True ThenIf resove ThenIf Component.GetSuppression2 = 1 ThenComponent.SetSuppression2 2End IfEnd IfElseIf Component.GetSuppression2 = 1 ThenIf MsgBox("装配体中含有轻化零件，是否将其还原？选择“否”将把所有轻化零件当作压缩零件处理。", vbYesNo + vbQuestion, "询问") = vbYes ThenresoveLightWeightConfirmed = Trueresove = TrueComponent.SetSuppression2 2ElseresoveLightWeightConfirmed = Trueresove = FalseEnd IfEnd IfChildren = Component.GetChildrenChildCount = UBound(Children) + 1If Not isTopLevelOnly Or level = 0 Then  '不是只处理顶层，或当前是顶层时，递归For i = 0 To (ChildCount - 1)Set Child = Children(i)resoveLightweight Child, level + 1Next iEnd If
End Function

2、读取用户设置值，即用户在界面上勾选的各个选项和填写的参数，把这些选项和参数都读进全局变量里，此步的实现代码较简单，不需要专门解释。

3、根据用户选项，决定是否对子装配体的子零部件的显示方式进行更改，即修改子装配体配置里的“显示”、“隐藏”或“提升”，具体实现代码如下：

'子装配体内零部件可见性设置，opt=36  '显示  38隐藏，  292 '提升
Function setChildDisplayInBOM(ByVal assblDoc As ModelDoc2, ByVal parentConfig As String, ByVal opt As Long) As BooleanDim components As VariantDim config As StringDim parentModel, thisModelDoc As ModelDoc2Set parentModel = assblDocDim compnt As VariantparentModel.EditConfiguration3 parentConfig, parentConfig, "", "", opt  '设置零件的可见性components = parentModel.GetComponents(True) '括号里为true时只获取装配体内第一层的零部件名称，为false时，获取所有层级的零部件If Not IsEmpty(components) ThenFor Each compnt In components '遍历装配体'获取配置名config = compnt.ReferencedConfigurationSet thisModelDoc = compnt.GetModelDoc2If Not thisModelDoc Is Nothing ThenIf thisModelDoc.GetType = 2 ThensetChildDisplayInBOM thisModelDoc, config, opt  '如果是装配体，则递归End IfEnd IfNextEnd If
End Function

4、遍历装配体：此步是最为关键的一步，因为要考虑的因素非常多，要考虑到零件是否轻化、是否压缩、是否封套、是否排除在BOM以外，如果是子装配体还要判断其子零件的显示方式是“隐藏”、“显示”或“提升”，还要考虑相同零件出现在不同子装配体的时候是否需要将其分开列出，在遍历的同时根据各种情况统计被压缩的零部件数量、不压缩的零件数量。这里采用2个全局字典对象变量dict1和dict2分别用于记录需要列出在Excel表中的零件数量(dict1记录数量）和零件component对象(dict2记录对象）。此步也是采用递归的方法进行遍历，具体实现代码如下：

'获得装配体内零部件的总数量
'showChildInBOM：1隐藏；2 显示；3 提升
Public Function CountComponents(ByVal Component As Object, ByVal level As Integer, ByVal showChildInBOM As Integer) As LongDim i           As IntegerDim Children    As VariantDim Child       As ObjectDim ChildCount  As IntegerDim comptModel As ModelDoc2Dim refereceKey As StringDim parent As ObjectDim showChild As IntegershowChild = 2 '默认为显示If Component.IsSuppressed And isCountSupressed Then'如果组件压缩，累计压缩组件数量CountSupressed = CountSupressed + 1ElseIf Component.ExcludeFromBOM And Not isReadNoBomPart Then'累计被排除在统计表之外的零部件数量CountBOMexludedPart = CountBOMexludedPart + 1ElseIf Component.IsEnvelope And Not isReadNoBomPart Then'累计被封套的零部件数量CountBOMexludedPart = CountBOMexludedPart + 1ElseSet comptModel = Component.GetModelDoc2If Not comptModel Is Nothing ThenIf comptModel.GetType = 1 ThenCountNonSupressedPart = CountNonSupressedPart + 1ElseCountNonSupressedAssbly = CountNonSupressedAssbly + 1'获取当前装配体配置的子零件显示方式If level = 0 ThenshowChild = 2 '对于顶层，所有零件都要显示ElseIf Not isSavePartSetting Then  '如果不更新配置到子装配体If isPartHide ThenshowChild = 1End IfIf isPartPromote ThenshowChild = 3End IfIf isPartCustom ThenshowChild = showChildPartsInBOM(comptModel, Component.ReferencedConfiguration)End IfElse  '按实际显示方式showChild = showChildPartsInBOM(comptModel, Component.ReferencedConfiguration)End IfEnd If'是否需要将不同装配体中的相同零件分开列出refereceKey = Component.GetPathName & "`" & Component.ReferencedConfigurationIf isSplitSameParts And level > 1 ThenSet parent = Component.GetParentIf Not parent Is Nothing ThenrefereceKey = refereceKey & "`" & parent.GetPathName & "`" & parent.ReferencedConfigurationEnd IfEnd If'非隐藏（显示或提升）时，添加零件If comptModel.GetType = 1 Then '对于零件，只要其父组件不是“隐藏”都要添加If showChildInBOM <> 1 ThenIf Not dict1.exists(refereceKey) Thendict1.Add refereceKey, 1dict2.Add refereceKey, ComponentElsedict1(refereceKey) = dict1(refereceKey) + 1End If'Else'countHideParts = countHideParts + 1   '统计隐藏的零件End IfElse  '对于装配体，只要其自身的配置设置不是“提升”都要添加If showChild <> 3 ThenIf Not dict1.exists(refereceKey) Thendict1.Add refereceKey, 1dict2.Add refereceKey, ComponentElsedict1(refereceKey) = dict1(refereceKey) + 1End IfElsecountHideAsms = countHideAsms + 1   '统计隐藏的装配体CountNonSupressedAssbly = CountNonSupressedAssbly - 1 '装配体数量减少重复计算End IfEnd IfEnd IfEnd IfChildren = Component.GetChildrenChildCount = UBound(Children) + 1CountSubParts = CountSubParts + ChildCountIf Not isTopLevelOnly Or level = 0 Then  '不是只处理顶层，或当前是顶层时，递归For i = 0 To (ChildCount - 1)Set Child = Children(i)If showChild <> 1 And Child.GetSuppression2 <> 1 Then   '当装配体的子零件设置为非隐藏且非轻化时，递归CountComponents Child, level + 1, showChildElseIf Child.GetSuppression2 = 1 ThencountLightWeightParts = countLightWeightParts + 1End IfNext iEnd If
End Function

需要注意的是，在上面这段程序中，获取component对象的子对象时，使用了GetChildren方法，当component对象是一个压缩装配体时，GetChildren方法获取到的子对象为空，而如果component对象是一个轻化的装配体时，GetChildren方法获取到的子对象并不为空，这正是我所参考的宏程序没有考虑到的地方，因此当遇到轻化的子装配体时，会导致程序出错。我在上面这段程序中进行了改进，使用判断语句当child.getSuppression2=1（1表示轻化）时，统计装配体为轻化，且不再做递归处理。5、将结果写入Excel：在上一步的遍历代码中，dict2这个字典对象已经收集到了所有需要填写到Excel表中的零部件对象，接下来就是把dict2中的每个对象的对应属性获取到，并把属性值写入到Excel中。获取零件属性的方法如下：

'获取模型指定配置、指定属性名称对应的属性
'configName是配置名，如果为空字符，则为自定义属性
'propName是属性名称
Public Function getProperty(ByVal myModelDoc As ModelDoc2, ByVal configName As String, ByVal propName As String) As StringDim cusPropMgr As CustomPropertyManagerDim swModelDocExt As ModelDocExtensionDim ValOut As StringDim ResolvedValOut As StringDim WasResolved As BooleanSet swModelDocExt = myModelDoc.ExtensionSet cusPropMgr = swModelDocExt.CustomPropertyManager(configName)cusPropMgr.Get6 propName, False, ValOut, ResolvedValOut, False, FalsegetProperty = ResolvedValOut
End Function

上面这段代码是获取“配置特定”或“自定义”的属性的，如果需要获取质量和密度属性，则使用另外一种方法，代码如下：

'构造自定义类型
Type MassTypemass As Doubledensity As Double
End Type
'获得模型质量和密度属性
Public Function GetMassProp(ByVal modelDoc As ModelDoc2, ByVal configName As String) As MassTypeDim MassProp()    As DoubleDim i             As ByteDim Dummy         As BooleanDim mass As DoubleDim density As DoubleDim mymass As MassTypeOn Error GoTo ErrorHandlermodelDoc.ShowConfiguration2 (configName)For i = 1 To 2MassProp = modelDoc.GetMassPropertiesIf Not IsEmpty(MassProp) Then Exit ForIf i = 2 And IsEmpty(MassProp) Then GoTo ErrorHandlerDummy = modelDoc.VisiblemodelDoc.Visible = TruemodelDoc.Visible = DummyNextmass = MassProp(5)density = MassProp(5) / MassProp(3) / 1000If mass > 1000 Thenmass = FormatNumber(mass, 0) ' 四舍五入至小数点后0位ElseIf mass > 100 Thenmass = FormatNumber(mass, 1) ' 四舍五入至小数点后1位ElseIf mass > 10 Thenmass = FormatNumber(mass, 2) ' 四舍五入至小数点后2位Elsemass = FormatNumber(mass, 3) ' 四舍五入至小数点后3位End If'mass = IIf(mass < "0.01", "0.01", mass) '最小重量10克density = FormatNumber(density, 2) ' 四舍五入至小数点后2位mymass.mass = massmymass.density = densityGetMassProp = mymassExit Function
ErrorHandler:mymass.mass = -1mymass.density = -1GetMassProp = mymass
End Function

把这些属性写入到Excel的方法如下：

'写入Excel
Public Function write2Excel() As BooleanxlWs.Range("G1") = CountNonSupressedAssbly - 1 '减去母装配体xlWs.Range("G2") = CountNonSupressedPartxlWs.Range("G3") = CountSupressedxlWs.Range("G4") = CountBOMexludedPartxlWs.Range("C1") = countHideAsmsxlWs.Range("C2") = countLightWeightPartsDim key As VariantDim configName As StringDim pathName As StringDim i, j As IntegerDim modelMass As MassTypeDim thisModel As ModelDoc2Dim parentCompt As Component2Dim PrevBMP As stdPicturei = 6For Each key In dict2.KeyspathName = Split(key, "`")(0)configName = Split(key, "`")(1)Set thisModel = dict2(key).GetModelDoc2If configName = "" ThenconfigName = swModel.GetActiveConfiguration.Name  '对于母装配体，获取到的配置名为空，需要新获取End IfxlWs.Range("A" & i) = pathNamexlWs.Range("B" & i) = getFileName(pathName, 3)xlWs.Range("C" & i) = configNamexlWs.Range("G" & i) = dict1(key)  '数量'modelMass = GetMassProp(thisModel, configName)  '获取重量属性xlWs.Range("E" & i) = modelMass.massxlWs.Range("F" & i) = modelMass.densityIf Not isInsPic Then  '如果不插入图片或图片插入到批注列时，D列写装配或零件xlWs.Range("D" & i) = IIf(getFileName(pathName, 1) = "SLDASM", "装配", "零件")Else '如果需要插入缩略图片'调整D列的内容If Not isInsAnnotation Then  '如果要插入单元格xlWs.Range("D" & i).RowHeight = PicRangHeightxlWs.Range("D" & i).ColumnWidth = PicRangWidthElse '如果要插入图片到批注中xlWs.Range("D" & i) = IIf(getFileName(pathName, 1) = "SLDASM", "装配", "零件")End IfIf Not isFramePic Then  '如果非线框图InsertPic pathName, configName, i, 4Else  '线框图InsWireFramePic pathName, configName, i, 4End IfEnd If'填写用户选定的属性For j = 9 To UBound(arr1) + 9If arr2(j - 9) = "配置特定" ThenxlWs.Cells(i, j).value = getProperty(thisModel, configName, arr1(j - 9))ElsexlWs.Cells(i, j).value = getProperty(thisModel, "", arr1(j - 9))End IfNextxlWs.Cells(i, j).value = CDbl(xlWs.Cells(i, 5).value) * CInt(xlWs.Cells(i, 7).value)Set parentCompt = dict2(key).GetParent  '获得父组件If Not parentCompt Is Nothing ThenIf parentPropType = "配置特定" ThenxlWs.Range("H" & i) = getProperty(parentCompt.GetModelDoc2, parentCompt.ReferencedConfiguration, parentPropName)ElsexlWs.Range("H" & i) = getProperty(parentCompt.GetModelDoc2, "", parentPropName)End IfElse  '无父组件，说明是顶层子部件If pathName <> strAsmFileName Then  '根装配体不填写If parentPropType = "配置特定" ThenxlWs.Range("H" & i) = getProperty(swModel, swModel.GetActiveConfiguration.Name, parentPropName)ElsexlWs.Range("H" & i) = getProperty(swModel, "", parentPropName)End IfEnd IfEnd Ifi = i + 1Next'自动调整列宽If isAutoFit ThenxlWs.Columns("A:C").Columns.AutoFitxlWs.Columns("E:Z").Columns.AutoFitEnd If'文件全名列是否可见If Not isFileNameVisible ThenxlWs.Columns("A:A").ColumnWidth = 0.1End If'排序'获取排序列编号If isItemInArr(UserForm1.ComboBox2.Text, fixPropName) > -1 ThensortColumn = isItemInArr(UserForm1.ComboBox2.Text, fixPropName) + 1ElseIf isItemInArr(UserForm1.ComboBox2.Text, arr1) > -1 ThensortColumn = isItemInArr(UserForm1.ComboBox2.Text, arr1) + 9ElseIf UserForm1.ComboBox2.Text = "总重" ThensortColumn = UBound(arr1) + 10ElsesortColumn = 0End If'升降序排序If UserForm1.ComboBox3.Text = "升序" ThensortType = 1ElseIf UserForm1.ComboBox3.Text = "降序" ThensortType = 2ElsesortType = 0End IfIf sortColumn > 0 And sortType > 0 ThenWith xlWs.Range(xlWs.Cells(7, 1), xlWs.Cells(i, UBound(arr1) + 10)).Sort Key1:=.Columns(sortColumn), Order1:=sortTypeEnd WithEnd IfxlApp.Visible = True'另存导出的文件xlWb.SaveAs FileName:=getFileName(strAsmFileName, 2) & getFileName(strAsmFileName, 0) & "BOM.xlsx", FileFormat:=51End Function

本宏程序的swp文件已共享在网盘，如需下载，请关注微信公众号“全栈开发的码农”，点击“喜欢作者”，赞赏任意金额后，公众号会自动发送下载链接和提取码，如果仍未收到下载链接，可直接向公众号发送私信。