Private Sub proceBom()
Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2
Set SwApp = Application.SldWorks
Set SwModel = SwApp.ActiveDoc
Dim SwDraw As DrawingDoc, SwView As View
Set SwDraw = SwModel
Set SwView = SwDraw.GetFirstView
Set SwView = SwView.GetNextView
Dim ConfName
ConfName = SwView.ReferencedConfiguration
Set SwView = SwView.GetNextView
SwView.ReferencedConfiguration = ConfName
Debug.Print SwView.Name
Dim SwSelMgr As SelectionMgr, Names
Set SwSelMgr = SwModel.SelectionManager
Dim SwFeat As Feature, SwBomFeat As BomFeature, tmp
tmp = SwModel.Extension.SelectByID2("VesselBOM", "BOMFEATURE", 0, 0, 0, False, 0, Nothing, 0)
'tmp = SwModel.Extension.SelectByID2("SaddleFBOM", "BOMFEATURE", 0, 0, 0, False, 0, Nothing, 0)
'tmp = SwModel.Extension.SelectByID2("SaddleSBOM", "BOMFEATURE", 0, 0, 0, False, 0, Nothing, 0)
Set SwBomFeat = SwSelMgr.GetSelectedObject5(1)
Set SwFeat = SwBomFeat.GetFeature
''
Names = SwBomFeat.GetConfigurations(False, Visible)
For jj = 0 To UBound(Names)
If Names(jj) = ConfName Then 'SwView.ReferencedConfiguration Then
Visible(jj) = True
Exit For
End If
Next jj
''
BoolStatus = SwBomFeat.SetConfigurations(False, Visible, Names)
Dim SwTabAnn As TableAnnotation
Set SwTabAnn = SwBomFeat.GetTableAnnotations(0)
BomTitle SwTabAnn
End Sub
''
Function BomTitle(SwTabAnn As TableAnnotation)
Dim cArr, Arr
'cArr = Array("序号", "标 准 号", "名 称", "数量", "材 料", "模型质量", "小计①", "下 料 尺 寸", "下料质量", "小计②", "②-①")
'cArr = Array("序号", "标 准 号", "名 称", "数量", "材 料", " ⑴", "①", "下 料 尺 寸", " ⑵", "②", "②-①")
cArr = Array("序号", "图号或标准号", "名 称", "数量", "材 料", " ⑴", "⑵", "下 料 尺 寸", " ①", "②", "②-⑵")
Arr = Array("序号", "图号", "名称", "数量", "材料", "质量", "", "下料尺寸", "下料质量", "", "")
Dim wArr
'wArr = Array(8, 20, 50, 8, 25, 12, 12, 40, 12, 12, 11)
wArr = Array(8, 17, 45, 8, 18, 10, 10, 35, 10, 10, 9)
Dim TextFormat As TextFormat
With SwTabAnn
''
For jj = 0 To .ColumnCount - 2
.SetColumnTitle jj, cArr(jj)
.SetColumnWidth jj, wArr(jj) / 1000, 0
.SetColumnCustomProperty jj, Arr(jj)
Next jj
''
For ii = 0 To .RowCount - 2
For jj = 0 To .ColumnCount - 1
Select Case jj
Case 2
.Text(ii, jj) = " " & Trim(.Text(ii, 2))
.CellTextHorizontalJustification(ii, jj) = swTextJustificationLeft
Case Else
.CellTextHorizontalJustification(ii, jj) = swTextJustificationCenter
End Select
''
Set TextFormat = .GetCellTextFormat(ii, jj)
With TextFormat
.CharHeight = 2.8 / 1000
.WidthFactor = 0.8
.TypeFaceName = "宋体"
If ii = SwTabAnn.RowCount - 1 Then
.Bold = True
Else
.Bold = False
End If
End With
.SetCellTextFormat .RowCount - 1, jj, False, TextFormat
Next jj
''
If .Text(ii, 3) <> "-" Then
If .Text(ii, 3) = 1 Then
If Val(.Text(ii, 5)) > 0 Then
.Text(ii, 6) = Format(.Text(ii, 5), "0.0#")
.Text(ii, 5) = " " 'Format(.Text(ii, 5), "0.0#")
End If
''
If Val(.Text(ii, 8)) > 0 Then
.Text(ii, 9) = Format(.Text(ii, 8), "0.0#")
.Text(ii, 8) = " " 'Format(.Text(ii, 8), "0.0#")
End If
Else
.Text(ii, 5) = Format(.Text(ii, 5), "0.0#")
.Text(ii, 8) = Format(.Text(ii, 8), "0.0#")
.Text(ii, 6) = Format(.Text(ii, 5) * .Text(ii, 3), "0.0#")
.Text(ii, 9) = Format(.Text(ii, 8) * .Text(ii, 3), "0.0#")
End If
If .Text(ii, 7) <> "" And Val(.Text(ii, 9)) > 0 Then
.Text(ii, 10) = Format(Val(.Text(ii, 9)) - Val(.Text(ii, 6)), "0")
Else
.Text(ii, 8) = " "
.Text(ii, 9) = " "
End If
End If
Next ii
''
For ii = 0 To .RowCount - 1
.SetRowHeight ii, 5 / 1000, 0
Next ii
''
End With