【分享】Replace BOM Table

gt.adan

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

1. 'Replace BOM
   
2. '刪除原工程圖中的BOM,並插入新BOM到指定的座標
   
3. Dim swApp As SldWorks.SldWorks
   
4. Dim swModel As SldWorks.ModelDoc2
   
5. Dim swSelMgr As SldWorks.SelectionMgr
   
6. Dim swFeatMgr As SldWorks.FeatureManager
   
7. Dim swFeat As SldWorks.Feature
   
8. Dim swView As SldWorks.View
   
9. Dim swBomAnn As BomTableAnnotation
   
10. Dim swBomFeat As SldWorks.BomFeature
    
11. Dim anchorType As Long
    
12. Dim bomType As Long
    
13. Dim configuration As String
    
14. Dim tableTemplate As String
    
15. Dim Names As Variant
    
16. Dim visible As Variant
    
17. Sub main()
    
18. Set swApp = Application.SldWorks
    
19. Set swModel = swApp.ActiveDoc
    
20. Set swFeat = swModel.FirstFeature
    
21.     While Not swFeat Is Nothing
    
22.         If "BomFeat" = swFeat.GetTypeName Then
    
23.             swFeat.Select2 False, -1
    
24.             swModel.Extension.DeleteSelection2 swDeleteSelectionOptions_e.swDelete_Absorbed
    
25.         End If
    
26.         Set swFeat = swFeat.GetNextFeature
    
27.     Wend
    
28. Set swSelMgr = swModel.SelectionManager
    
29. Set swFeatMgr = swModel.FeatureManager
    
30. Set swDraw = swModel
    
31. Set swSheet = swDraw.GetCurrentSheet
    
32. 'Select View
    
33. swModel.ClearSelection2 True
    
34. Set swView = swDraw.GetCurrentSheet.GetViews()(0)
    
35. 'Insert BOM Table
    
36. anchorType = SwConst.swBOMConfigurationAnchorType_e.swBOMConfigurationAnchor_BottomRight
    
37. bomType = SwConst.swBomType_e.swBomType_TopLevelOnly
    
38. swModel.ClearSelection2 True
    
39. configuration = ""
    
40. tableTemplate = ""   '<---在雙引號內輸入新零件表模板完整路徑
    
41. Set swBomAnn = swView.InsertBomTable2(False, 0, 0, anchorType, bomType, configuration, tableTemplate)
    
42. '上一行代碼中,False後接的 0,0 即為工程圖中的 X,Y 座標值,自行依需要插入表格位置修改,唯注意比例是 1:5000
    
43. Set swBomFeat = swBomAnn.BomFeature
    
44. Names = swBomFeat.GetConfigurations(False, visible)
    
45. visible(0) = True
    
46. boolstatus = swBomFeat.SetConfigurations(True, visible, Names)
    
47. swFeatMgr.UpdateFeatureTree
    
48. End Sub

复制代码

PS. 此巨集僅為單一工程圖檔使用，有需要的朋友自便，
      更可拜讀悶哥之前的教學「批量處理宏」，將其修改為更便利的工具。

xiabulai

mach12

scattie

qxzch

q297369733

wxg263

scattie

风中de沙

cher_liu