AnsweredAssumed Answered

Macro to select sheet metal feature by type (not name) and read thickness

Question asked by Jarrad Tait on Feb 23, 2021
Latest reply on Feb 24, 2021 by Artem Taturevych

I already have this code which looks in a folder and makes an excel spreadsheet of the mass and thickness of each part configuariton but the major flaw is that the sheet metal feature is never named consistently and is not in any folder tree so Set swFeat = swModel.FeatureByName("Sheet-Metal") is a very poor way to go about things. I've heard there is a way to traverse the feature tree not by name but by feature type but I can't find the syntax documentation so I'm asking here if anyone knows what that line would look like

 

Thanks,

 

Dim swApp As Object
Dim part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub Del_Table()

Set swApp = Application.SldWorks
Set part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = part.ActiveView
boolstatus = part.Extension.SelectByID2("Gauge Table", "SM ENVIRONMENT TABLE", 0, 0, 0, False, 0, Nothing, 0)
part.EditDelete

Call KFactor

End Sub
Private Sub KFactor()

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelExt As SldWorks.ModelDocExtension
Dim swFeat As SldWorks.Feature
Dim swSelMgr As SldWorks.SelectionMgr
Dim swSheetMetalTemplFeature As SldWorks.Feature
Dim swSheetMetal As SldWorks.SheetMetalFeatureData
Dim bRet As Boolean

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Set swModelExt = swModel.Extension
Set swSelMgr = swModel.SelectionManager

'Set swFeat = swSelMgr.GetSelectedObject5(1)
Set swFeat = swModel.FeatureByName("Sheet-Metal")

On Error Resume Next
If swFeat Is Nothing = True Then
swApp.SendMsgToUser2 "Sheet-Metal feature not found. " & vbNewLine & vbNewLine & "Make sure the part is a sheet metal part and the sheet metal feature is not renamed.", swMbWarning, swMbOk
Exit Sub
End If

'Set swSheetMetalTemplFeature = swModelExt.GetTemplateSheetMetal
'Set swSheetMetal = swSheetMetalTemplFeature.GetDefinition
Set swSheetMetal = swFeat.GetDefinition

 

bRet = swSheetMetal.AccessSelections(swModel, Nothing): Debug.Assert bRet
swSheetMetal.KFactor = 0.407437
bRet = swFeat.ModifyDefinition(swSheetMetal, swModel, Nothing): Debug.Assert bRet

Set swApp = Application.SldWorks
Call AutoRelief
End Sub

Private Sub AutoRelief()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Set swModelExt = swModel.Extension
Set swSelMgr = swModel.SelectionManager

'Set swFeat = swSelMgr.GetSelectedObject5(1)
Set swFeat = swModel.FeatureByName("Sheet-Metal")

'Set swSheetMetalTemplFeature = swModelExt.GetTemplateSheetMetal
'Set swSheetMetal = swSheetMetalTemplFeature.GetDefinition
Set swSheetMetal = swFeat.GetDefinition

 

bRet = swSheetMetal.AccessSelections(swModel, Nothing): Debug.Assert bRet
swSheetMetal.UseAutoRelief = True
swSheetMetal.AutoReliefType = 3
swSheetMetal.ReliefRatio = 0.2
bRet = swFeat.ModifyDefinition(swSheetMetal, swModel, Nothing): Debug.Assert bRet

Set swApp = Application.SldWorks

Call Equation
End Sub

Private Sub Equation()

Set swApp = Application.SldWorks
Set part = swApp.ActiveDoc
boolstatus = part.Extension.SelectByID2("Equations", "EQNFOLDER", 0, 0, 0, False, 0, Nothing, 0)
Dim swEquationMgr As Object
Set swEquationMgr = part.GetEquationMgr()
swEquationMgr.Add -1, """K-Factor""=IIF ( ""Thickness"" < 4 , 0.2734 , IIF ( ""Thickness"" < 5 , 0.36 , IIF ( ""Thickness"" < 8 , 0.44 , 0.5 ) ) )"""
swEquationMgr.Add -1, """D1@sheet-metal""=""Thickness"""""
swEquationMgr.Add -1, """D2@sheet-metal""=""K-factor"""""
boolstatus = part.ForceRebuild()

Call Description

End Sub

Private Sub Description()

Dim swApp As SldWorks.SldWorks
Dim modelDoc As SldWorks.ModelDoc2
Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim retval As Long
Dim TEXT As String
Dim str As String

 

str = "Plate " & Chr(34) & "Thickness@Sheet-Metal" & Chr(34) & " mm"

Set swApp = Application.SldWorks
Set modelDoc = swApp.ActiveDoc
Set cusPropMgr = modelDoc.Extension.CustomPropertyManager("Default")

'with this code you add a new custom property
'retval = cusPropMgr.Add2("Description", swCustomInfoText, str)
'if you want to change an existing custom property use the code below

retval = cusPropMgr.Set("Description", str)

MsgBox " Sheet-Metal feature set. "


End Sub

Outcomes