【分享】Replace BOM Table

只看该作者 · 发表于 2019-3-10 03:12:53

马上注册，结交更多同行朋友，交流，分享，学习。

您需要登录才可以下载或查看，没有帐号？注册

x

本帖最后由 gt.adan 于 2019-3-10 21:39 编辑

壇子內有人問起，剛好前一陣子碰到一樣的工作要求。
取經了原廠論壇前輩們寫的巨集，自個兒瞎唬弄拼湊了一個還堪用的代碼…
老手用力噴！噴完請不吝指導較為簡潔的寫述方式~~

'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