AnsweredAssumed Answered

How to use sentence  of InsertTableDrivenPattern

Question asked by Yong Ning on Nov 27, 2014

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

Attachments

Outcomes