1 Reply Latest reply on Nov 2, 2014 8:39 PM by Yong Ning

    How to set Title Block Table in API

    Yong Ning

      00.jpg

       

      Private Sub del1()

          Set SwApp = Application.SldWorks

          Set SwModel = SwApp.ActiveDoc

        Dim SwSelMgr As SelectionMgr

          Set SwSelMgr = SwModel.SelectionManager

        Dim SwTabBlk 'As TableAnnotation   'TitleBlock

       

          Set SwTabBlk = SwSelMgr.GetSelectedObject5(1)

          Debug.Print SwTabBlk.??????????????????

       

      End Sub

       

      Dim SwTabBlk 'As → How set ?

      1 TableAnnotation??  → result is Error?

      2  TitleBlock??  → result is Error?

        • Re: How to set Title Block Table in API
          Yong Ning

          2010 SolidWorks API Help - Get Title Block Tables Example (VBA)

          http://help.solidworks.com/2010/english/api/sldworksapi/get_title_block_tables_example_vb6.htm

           

          Find method

           

          ''

          Private Sub del()

             Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

                Set SwApp = Application.SldWorks

                Set SwModel = SwApp.ActiveDoc

             Dim SwSelMgr As SelectionMgr

                Set SwSelMgr = SwModel.SelectionManager

             Dim TitleBlkAnn As TitleBlockTableAnnotation

                Set TitleBlkAnn = SwSelMgr.GetSelectedObject6(1, 0)

             Dim SwFeat As Feature

                Set SwFeat = TitleBlkAnn.TitleBlockTableFeature.GetFeature

             Dim SwAnn As TableAnnotation, tmp

             With TitleBlkAnn

                tmp = .TitleBlockTableFeature.GetTableAnnotations

                Set SwAnn = tmp(0) 

             End With

             ''

             With SwAnn

                Debug.Print .ColumnCount, .RowCount

             End With

          End Sub

           

          *******************************

           

          Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

          Private Sub del20141023()

               Set SwApp = Application.SldWorks

               Set SwModel = SwApp.ActiveDoc

             Dim SwFeat As Feature, Str

               Str = "标题块表1"

               Set SwFeat = SwModel.FeatureByName(Str)

             Dim SwSelMgr As SelectionMgr

                Set SwSelMgr = SwModel.SelectionManager

                ''

             Dim SwTitleFeat As TitleBlockTableFeature

                Set SwTitleFeat = SwSelMgr.GetSelectedObject5(1)

                Debug.Print SwTitleFeat.GetFeature.Name

             Dim TitleBlkAnn As TitleBlockTableAnnotation

                Set TitleBlkAnn = SwTitleFeat.GetTableAnnotations(0)

             Dim SwAnn As TableAnnotation, Tmp

                Tmp = TitleBlkAnn.TitleBlockTableFeature.GetTableAnnotations

                Set SwAnn = Tmp(0)

             With SwAnn

                Debug.Print .Title, .RowCount, .ColumnCount

             End With

          End Sub

           

          ****************************************************************************

           

           

          Function SwTableFindMergeRng(SwTable As TableAnnotation, Rng As Range)

             Dim TextFormat As TextFormat, oTextFormat As TextFormat

             Dim oRng As Range, wFactor, Cc

             Cc = Rng.Columns.Count

           

             For ii = 1 To Rng.Rows.Count

               ''

                For jj = 1 To Rng.Columns.Count

                   Set oRng = Rng(ii, jj)

                   wFactor = oRng(1, Cc + 1)

                   ''

                   With oRng

                      If .MergeArea.Count > 1 Then

                        If .Address = .MergeArea.Cells(1, 1).Address Then

                          'Debug.Print oRng.Address, oRng, oRng.MergeArea.Rows.Count, oRng.MergeArea.Columns.Count

                          SwTable.MergeCells ii - 1, jj - 1, ii - 1 + .MergeArea.Rows.Count - 1, jj - 1 + .MergeArea.Columns.Count - 1

                          SwTable.Text(ii - 1, jj - 1) = .Value

                          ''

                          Set TextFormat = WidthFactorTextFormat(SwTable.GetCellTextFormat(ii - 1, jj - 1), oRng, wFactor, 1)

           

           

                          SwTable.SetCellTextFormat ii - 1, jj - 1, False, TextFormat

                        End If

                      Else

                        ''

                        With SwTable

                          If IsNumeric(oRng.Value) Then

                            .Text(ii - 1, jj - 1) = Format(oRng.Value, "0.0#")

                          Else

                            .Text(ii - 1, jj - 1) = oRng.Value

                          End If

                          ''

                          Set TextFormat = WidthFactorTextFormat(.GetCellTextFormat(ii - 1, jj - 1), oRng, wFactor, 1)

                          .SetCellTextFormat ii - 1, jj - 1, False, TextFormat

                        End With

                      End If

                   End With

                   ''

                   With SwTable

                          If Not TextFormat Is Nothing Then

                             Select Case oRng.HorizontalAlignment

                               Case xlLeft

                                 .CellTextHorizontalJustification(ii - 1, jj - 1) = 1

                               Case xlCenter

                                 .CellTextHorizontalJustification(ii - 1, jj - 1) = 2

                               Case xlRight

                                 .CellTextHorizontalJustification(ii - 1, jj - 1) = 3

                             End Select

                          End If

                   End With

                 

                Next jj

              

                'Debug.Print Rng(ii, -1), Rng(ii, -1).Address, ii, jj

                'Stop

                SwTable.SetRowHeight ii - 1, Rng(ii, -1) / 1000, 0

             Next ii

          End Function

          ''

          Function WidthFactorTextFormat(TextFormat As TextFormat, Rng As Range, wFactor, LineSpec) As TextFormat

            ''

            With TextFormat

                   .Italic = Rng.Font.Italic

                   .Bold = Rng.Font.Bold

                   .LineSpacing = LineSpec / 1000

                   'Debug.Print Rng.Address, Rng.Font.Size

                   'Stop

                   .charHeight = (Rng.Font.Size - 6) / 1000

                 

                   .TypeFaceName = Rng.Font.Name

                   .WidthFactor = wFactor

            End With

            'Debug.Print Rng.Address, Rng.Font.Size

            Set WidthFactorTextFormat = TextFormat

           

          End Function