0 Replies Latest reply on Jan 23, 2016 3:28 AM by Yong Ning

    How to use sentence  of InsertTableDrivenPattern

    Yong Ning

      2010 SolidWorks API Help - InsertTableDrivenPattern Method (IFeatureManager)

      http://help.solidworks.com/2010/english/api/sldworksapi/solidworks.interop.sldworks~solidworks.interop.sldworks.ifeaturemanager~inserttabledrivenpattern.htmlTable-driven+Pattern.jpg

       

      value = instance.InsertTableDrivenPattern(FileName, PointVar, UseCentrod, GeomPatt)

       

      How to write FileName???????

      FileName = "E:\MyWorkSummary\BESmodel\浮头换热器\Tube Bundle\" & "1.Txt"

       

       

      PointVar? → How to Set  Point varay

      ??

       

      PointVar → How to set Point

       

      UseCentrod → True ? or False?

      GeomPatt → True? or False?

       

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

      Private Sub ss()

         Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

            Set SwApp = Application.SldWorks

            Set SwModel = SwApp.ActiveDoc

         Dim SwFeatMgr As FeatureManager, Tab1 As TablePatternFeatureData

            Set SwFeatMgr = SwModel.FeatureManager

         Dim FileName, Pt(1) As Double

            Debug.Print SwModel.GetPathName

            Path = "E:\MyWorkSummary\BESmodel\浮头换热器\Tube Bundle\"

            FileName = Path & "1.Txt"

            SwFeatMgr.InsertTableDrivenPattern FileName, Pt, True, True

            Stop

      End Sub

       

       

      2013 SolidWorks API Help - Get Points of Repeating Elements in Table-driven Pattern (VBA)

      http://help.solidworks.com/2013/English/api/sldworksapi/Get_Points_of_Repeating_Elements_in_Table-driven_Pattern_Example_VB.htm

       

       

       

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

      Function InsTabDrivenPattern(SwModel As ModelDoc2, FileName, FeatName, CoordName, BodyArr)

         Dim SwFeat As Feature, SwFeatMgr As FeatureManager

         Set SwFeatMgr = SwModel.FeatureManager

         With SwModel.Extension

           .SelectByID2 CoordName, "COORDSYS", 0, 0, 0, False, 16, Nothing, 0

           For ii = 0 To UBound(BodyArr)

             .SelectByID2 BodyArr(ii), "BODYFEATURE", 0, 0, 0, True, 4, Nothing, 0

           Next ii

         End With

         ''

         Set SwFeat = SwFeatMgr.InsertTableDrivenPattern(FileName, Nothing, True, True)

         SwFeat.Name = FeatName

         'SwFeat.Select True

         'SwModel.EditSuppress2

      End Function

      ''

      Private Sub del20150205()

         Dim T: T = Timer

         Dim Xls As Excel.Application, Rng As Range

            Set Xls = GetObject(, "Excel.Application")

            Set Rng = Xls.Selection

         Dim Rng1 As Range, Rng2 As Range, FileName

            Set Rng1 = Rng.Areas(1)

            Set Rng2 = Rng.Areas(2)

            ''

         Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

            Set SwApp = Application.SldWorks

            Set SwModel = SwApp.ActiveDoc

         Dim Path, BodyArr: BodyArr = Array("Hole")

            Path = SwModel.GetPathName

            Path = Left(Path, InStrRev(Path, "\")) & "布管\"

            For ii = 1 To Rng.Rows.Count

               SwModel.ShowConfiguration2 Rng1(ii, 1)

              

               FileName = Path & Rng2(ii, 1)

               InsTabDrivenPattern SwModel, FileName, Rng1(ii, 1), "CoordSys", BodyArr

               Debug.Print Rng1(ii, 1),

               printTiming T

               UnSuppressConfigEquiFeat SwModel

               'Stop

              

            Next ii

            printTiming T

            SwModel.SaveAs Path & "del.SldPrt"

            SwApp.CloseDoc SwModel.GetTitle

            printTiming T

           '

           SwApp.ExitApp

            Timing T

      End Sub

       

       

       

       

      ''

      Private Sub replTablePatternFeatName()

         Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

            Set SwApp = Application.SldWorks

            Set SwModel = SwApp.ActiveDoc

         Dim ConfArr, Kk As Integer

            Kk = 1

            ConfArr = SwModel.GetConfigurationNames

         Dim SwFeat As Feature

            'For ii = 0 To UBound(ConfArr)

               SwModel.ShowConfiguration ConfArr(ii)

               Set SwFeat = SwModel.FirstFeature

              

               Do While Not SwFeat Is Nothing

                  If SwFeat.GetTypeName = "TablePattern" Then

                     SwFeat.Name = Trim(Replace(SwFeat.Name, "FixTubeSheet", ""))

                     Debug.Print SwFeat.Name

                    

                  End If

                  Set SwFeat = SwFeat.GetNextFeature

               Loop

               'SwModel.EditSuppress

               Stop

            'Next ii

      End Sub

       

       

      ''

      Private Sub TablePatternSuppress()

         Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

            Set SwApp = Application.SldWorks

            Set SwModel = SwApp.ActiveDoc

         Dim ConfArr, Kk As Integer

            Kk = 1

            ConfArr = SwModel.GetConfigurationNames

         Dim SwFeat As Feature

            For ii = 0 To UBound(ConfArr)

               SwModel.ShowConfiguration ConfArr(ii)

               Set SwFeat = SwModel.FirstFeature

              

               Do While Not SwFeat Is Nothing

                  If SwFeat.GetTypeName = "TablePattern" Then

                     SwFeat.Select True

                  End If

                  Set SwFeat = SwFeat.GetNextFeature

               Loop

               SwModel.EditSuppress

            Next ii

      End Sub

       

       

       

       

      Private Sub TablePatternUnSuppress()

         Dim T: T = Timer

         Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

            Set SwApp = Application.SldWorks

            Set SwModel = SwApp.ActiveDoc

         Dim ConfArr, Kk As Integer

            Kk = 1

            ConfArr = SwModel.GetConfigurationNames

         Dim SwFeat As Feature

        

            'For ii = 0 To UBound(ConfArr) - 6

            For ii = UBound(ConfArr) - 5 To UBound(ConfArr)

               SwModel.ShowConfiguration ConfArr(ii)

               Set SwFeat = SwModel.FirstFeature

              

               Do While Not SwFeat Is Nothing

                  If SwFeat.Name = ConfArr(ii) Then

                     Debug.Print SwFeat.Name

                     Debug.Print Timer / 60

                     SwFeat.Select True

                    

                     SwModel.EditUnsuppress

                     'Stop

                     Exit Do

                  End If

                  Set SwFeat = SwFeat.GetNextFeature

               Loop

              

              

              

            Next ii

         Timing T

      End Sub

      ''

      Private Sub unSuppressFeat()

         Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

            Set SwApp = Application.SldWorks

            Set SwModel = SwApp.ActiveDoc

         Dim ConfArr, SwConf As Configuration

           

            ''

         Dim SwFeat As Feature

           With SwModel

              ConfArr = .GetConfigurationNames

              For ii = 0 To UBound(ConfArr)

                 .ShowConfiguration ConfArr(ii)

                 Set SwFeat = .FeatureByName("Coordinate System1")

                 SwFeat.Select True

                 Set SwFeat = .FeatureByName("Delta")

                 SwFeat.Select True

                 .EditUnsuppress

              Next ii

           End With

      End Sub