BOM Scaling
Lets you scale the BOM size. Available only after you click the pan icon in the upper left corner of an existing bill of materials in a part or assembly.
******************************************************************
no find API code of bom scaling. follow code is replace code.
********************************************************************
Private Sub eAsmFile()
Dim Xls As Excel.Application, Rng As Range, oRng As Range
Set Xls = GetObject(, "Excel.Application")
Dim Path
Path = Xls.ActiveWorkbook.Path & "\PDF\"
''
Dim Sht As Worksheet, Str
Set Sht = Xls.Worksheets("JB4715")
Set Rng = Sht.Cells(1, "BH").CurrentRegion
Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2
Set SwApp = Application.SldWorks
Set SwModel = SwApp.ActiveDoc
Dim sFileName
''
SwApp.SetUserPreferenceIntegerValue swEdrawingsSaveAsSelectionOption, swEdrawingSaveSelected
Dim nErrors As Long, nWarnings As Long
''
'Dim fileConfig As String, fileDispName As String, fileOptions As Long
''
For jj = 1 To Rng.Columns.Count
Set oRng = Xls.Range(Rng(2, jj).Formula)
Debug.Print oRng.Address
Str = ""
For ii = 1 To oRng.Rows.Count
Str = oRng(ii, 1) & Chr(10) & Str
Next ii
sFileName = Rng(1, jj) & ".eAsm"
sFileName = Path & sFileName
'' Stop
Debug.Print sFileName
SwApp.SetUserPreferenceStringListValue swUserPreferenceStringListValue_e.swEmodelSelectionList, Str
SwModel.Extension.SaveAs sFileName, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, nErrors, nWarnings
Next jj
End Sub
''
''
Private Sub del20160707()
Dim Xls As Excel.Application, Rng As Range
Set Xls = GetObject(, "Excel.Application")
Dim Sht As Worksheet
Set Sht = Xls.Worksheets("GeneralTable")
Set Rng = Sht.Cells(5, "AK")
''Debug.Print Rng.Parent.Name
Dim Str, tmp, ii, jj, Xx, Yy, Row
Str = "材料明细表"
Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2, SwDraw As DrawingDoc
Set SwApp = Application.SldWorks
Set SwModel = SwApp.ActiveDoc
Dim SwSelMgr As SelectionMgr
Set SwSelMgr = SwModel.SelectionManager
Dim sConfNames(0) As String, bVisible(0) As Boolean
Dim SwAnn As Annotation, Pp
Dim SwTextFormat As TextFormat
Dim ConfArr, swConf As Configuration
ConfArr = SwModel.GetConfigurationNames
Dim SwBomFeat As BomFeature, SwTabAnn As TableAnnotation
Dim SwBomTab As BomTableAnnotation, BomTab As BomTable
''
'For ii = UBound(ConfArr) - 1 To UBound(ConfArr) - 1
For ii = 0 To UBound(ConfArr)
SwModel.ShowConfiguration2 ConfArr(ii)
Set swConf = SwModel.GetActiveConfiguration
tmp = SwModel.Extension.SelectByID2(Str, "BOMFEATURE", 0, 0, 0, False, 0, Nothing, 0)
Set SwBomFeat = SwSelMgr.GetSelectedObject5(1)
SwBomFeat.Configuration = swConf.Name
''
sConfNames(0) = ConfArr(ii) 'ConfName
bVisible(0) = True
ConfNames = sConfNames
SwBomFeat.SetConfigurations False, bVisible, ConfNames
''Debug.Print ii, SwBomFeat.Configuration, swConf.Name, SwBomFeat.Configuration = swConf.Name
'Set SwBomTab = SwBomFeat
Set SwBomTab = SwBomFeat.GetTableAnnotations(0)
Set SwTabAnn = SwBomTab
With SwTabAnn
''Debug.Print .Type, .Type
For jj = 0 To .ColumnCount - 1
.Text(0, jj) = Rng(1, jj + 1)
'Rng(0, jj + 1) = Int(.GetColumnWidth(jj) * 1000)
.SetColumnWidth jj, Rng(0, jj + 1) / 1000, 0
Next jj
Set SwAnn = .GetAnnotation
''
Xx = Rng(2, 1) / 1000
Yy = Rng(2, 2) / 1000
''
SwAnn.SetPosition Xx, Yy, 0
''
For Row = 0 To .RowCount - 1
.SetRowHeight Row, 180 / 1000, 0
Next Row
End With
Set SwTextFormat = SwAnn.GetTextFormat(0)
With SwTextFormat
'.CharHeight = 0.2 '200 / 1000
'.TypeFaceName = "黑体"
End With
'SwAnn.SetTextFormat 0, False, swtextfomrat
DigitsSwAnn SwTabAnn '
'SwModel.EditRebuild3
Next ii
End Sub
'*********************************