【分享】Replace BOM Table - iCAx开思网

'Replace BOM
'刪除原工程圖中的BOM,並插入新BOM到指定的座標
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swFeatMgr As SldWorks.FeatureManager
Dim swFeat As SldWorks.Feature
Dim swView As SldWorks.View
Dim swBomAnn As BomTableAnnotation
Dim swBomFeat As SldWorks.BomFeature
Dim anchorType As Long
Dim bomType As Long
Dim configuration As String
Dim tableTemplate As String
Dim Names As Variant
Dim visible As Variant
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swFeat = swModel.FirstFeature
While Not swFeat Is Nothing
If "BomFeat" = swFeat.GetTypeName Then
swFeat.Select2 False, -1
swModel.Extension.DeleteSelection2 swDeleteSelectionOptions_e.swDelete_Absorbed
End If
Set swFeat = swFeat.GetNextFeature
Wend
Set swSelMgr = swModel.SelectionManager
Set swFeatMgr = swModel.FeatureManager
Set swDraw = swModel
Set swSheet = swDraw.GetCurrentSheet
'Select View
swModel.ClearSelection2 True
Set swView = swDraw.GetCurrentSheet.GetViews()(0)
'Insert BOM Table
anchorType = SwConst.swBOMConfigurationAnchorType_e.swBOMConfigurationAnchor_BottomRight
bomType = SwConst.swBomType_e.swBomType_TopLevelOnly
swModel.ClearSelection2 True
configuration = ""
tableTemplate = "" '<---在雙引號內輸入新零件表模板完整路徑
Set swBomAnn = swView.InsertBomTable2(False, 0, 0, anchorType, bomType, configuration, tableTemplate)
'上一行代碼中,False後接的 0,0 即為工程圖中的 X,Y 座標值,自行依需要插入表格位置修改,唯注意比例是 1:5000
Set swBomFeat = swBomAnn.BomFeature
Names = swBomFeat.GetConfigurations(False, visible)
visible(0) = True
boolstatus = swBomFeat.SetConfigurations(True, visible, Names)
swFeatMgr.UpdateFeatureTree
End Sub

复制代码