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,
SolidworksApi/macrosDim swApp As Object
Dim part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As LongSub 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.EditDeleteCall 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 BooleanSet 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.GetDefinitionbRet = swSheetMetal.AccessSelections(swModel, Nothing): Debug.Assert bRet
swSheetMetal.KFactor = 0.407437
bRet = swFeat.ModifyDefinition(swSheetMetal, swModel, Nothing): Debug.Assert bRetSet swApp = Application.SldWorks
Call AutoRelief
End SubPrivate 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.GetDefinitionbRet = 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 bRetSet swApp = Application.SldWorks
Call Equation
End SubPrivate 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 Stringstr = "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 belowretval = cusPropMgr.Set("Description", str)
MsgBox " Sheet-Metal feature set. "
End Sub