How to use BOM Scaling with API?

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

'*********************************

SolidworksApi macros