2010 SolidWorks API Help - InsertTableDrivenPattern Method (IFeatureManager)
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)
********************************
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
SolidworksApi macros