I've written a VBA macro (with help from an earlier post by Rocheey - THANKS!) that extracts the general sheet metal parameters and writes them to custom properties.
This approach works OK for parts that use a constant K-factor for all bends. Unfortunately, I've run into some parts that use different K- factors for some bends.
Does anyone know a way to extract this data and write the values to custom properties?
Ultimately, this information will be placed into a table on the 2D drawing.
Here is the code I'm using thus far:
'Portions of this macro written by snipped-for-privacy@hotmail.com 'Obtained from post dated Mar 31, 2004 on comp.cad.solidworks newsgroup 'Modified on 2/13/07 by john to add custom properties of sheetmetal parameters 'User must pre-select desired configuration to assign custom properties to ' Dim swapp As SldWorks.SldWorks Const swTnSheetMetal As String = "SheetMetal"
Sub main() ' demo code to show return values of Function Dim retProps As Variant
Set swapp = GetObject("", "Sldworks.application") If swapp Is Nothing Then Exit Sub
retProps = SheetMetalProps() If IsEmpty(retProps) Then msg$ = "Cannot Locate a Sheet metal Part" Else msg$ = "Bend Allowance : " & retProps(0) & vbCrLf msg$ = msg$ & "Bend Radius : " & retProps(1) & vbCrLf msg$ = msg$ & "K Factor : " & retProps(2) & vbCrLf msg$ = msg$ & "Relief ratio : " & retProps(3) & vbCrLf msg$ = msg$ & "Part Thickness : " & retProps(4) & vbCrLf msg$ = msg$ & "Relief Type : " & retProps(5) & vbCrLf End If '
MsgBox msg$
End Sub
Function SheetMetalProps() As Variant ' Routine returns a safearray of the sheet metal ' properties from the active Model/cfg. ' ' Note that these are the DEFAULT values as assigned in the ' Sheet metal feature, and any (except thickness?) can be ' overridden in individual features, so your actual mileage ' may vary.
' Return Index 0: (Default) Bend Allowance ' Return Index 1: (Default) Bend Radius ' Return Index 2: (Default) K Factor ' Return Index 3: (Default) Relief ratio ' Return Index 4: Part Thickness ' Return Index 5: relief type: None = 4 ' Obround = 3 ' Rectangular = 1 ' Tear = 2 ' Tear Bend = 5 ' (These seeming arbitrary values were assigned by SWConst, not me)
' if the active part is NOT a sheet metal part, the return value 'is *EMPTY*, so check this return value first!
Dim smModel As SldWorks.ModelDoc2 Dim smFeat As SldWorks.Feature Dim SMData As SldWorks.SheetMetalFeatureData
Dim BendAllowance As Double Dim BendRadius As Double Dim KFactor As Double Dim ReliefRatio As Double Dim PartThickness As Double Dim BendReliefType As Long Dim UsesAutoRelief As Long Dim retval As String ' Dim vConfigName As Variant ' Dim sConfigName As String ' Dim i As Long
Set smModel = swapp.ActiveDoc ' Set smCustPropMgr = smModel.CustomInfo2 ' Set smConfigMgr = smModel.ConfigurationManager ' Set smConfig = smConfigMgr.ActiveConfiguration ' Set smCustPropMgr = smConfig.CustomPropertyManager
If Not (smModel Is Nothing) Then
' vConfigName = smModel.GetConfigurationNames ' ' For i = 0 To UBound(vConfigName) ' ' sConfigName = vConfigName(i) ' ' Set smConfig = smModel.GetConfigurationByName(sConfigName)
' we have a doc, does it have a sheet metal feature? Set smFeat = FindFeature(smModel, swTnSheetMetal) If Not (smFeat Is Nothing) Then ' its a sheet metal part
' Now get the sheet metal params Set SMData = smFeat.GetDefinition If Not (SMData Is Nothing) Then ' get the data PartThickness = SMData.Thickness BendAllowance = SMData.BendAllowance BendRadius = SMData.BendRadius KFactor = SMData.KFactor
'Remove existing sheetmetal value custom properties from document level custom properties
retval = smModel.DeleteCustomInfo2("", "K_Factor") retval = smModel.DeleteCustomInfo2("", "Part_Thickness") retval = smModel.DeleteCustomInfo2("", "Bend_Allowance") retval = smModel.DeleteCustomInfo2("", "Bend_Radius")
'Add custom properties to document level custom properties
retval = smModel.AddCustomInfo3("", "K_Factor", swCustomInfoText, KFactor) retval = smModel.AddCustomInfo3("", "Part_Thickness", swCustomInfoDouble, PartThickness) retval = smModel.AddCustomInfo3("", "Bend_Allowance", swCustomInfoDouble, BendAllowance) retval = smModel.AddCustomInfo3("", "Bend_Radius", swCustomInfoDouble, BendRadius)
''Remove existing sheetmetal value custom properties from active configuration ' 'retval = smCustPropMgr.Delete("K_Factor") 'retval = smCustPropMgr.Delete("Part_Thickness") 'retval = smCustPropMgr.Delete("Bend_Allowance") 'retval = smCustPropMgr.Delete("Bend_Radius") ' ''Add custom properties with sheetmetal values for part thickness, bend allowance, bend radius and k factor ''to active configuration ' 'retval = smCustPropMgr.Add2("K_Factor", swCustomInfoText, KFactor) 'retval = smCustPropMgr.Add2("Part_Thickness", swCustomInfoDouble, PartThickness) 'retval = smCustPropMgr.Add2("Bend_Allowance", swCustomInfoDouble, BendAllowance) 'retval = smCustPropMgr.Add2("Bend_Radius", swCustomInfoDouble, BendRadius)
' see if we are using autorelief
UsesAutoRelief = SMData.UseAutoRelief If Not (UsesAutoRelief = 0) Then BendReliefType = SMData.AutoReliefType ReliefRatio = SMData.ReliefRatio Else BendReliefType = 4 ' None End If End If
End If
'Next i
End If
Set smModel = Nothing Set smFeat = Nothing Set SMData = Nothing Set smConfigMgr = Nothing Set smConfig = Nothing Set smCustPropMgr = Nothing
' if we have a thickness variable not equal to zero, then return all data, ' otherwise, return EMPTY
If Not (PartThickness = 0#) Then SheetMetalProps = Array(BendAllowance, BendRadius, KFactor, ReliefRatio, PartThickness, BendReliefType) End If
End Function
Function FindFeature(SearchDoc As SldWorks.ModelDoc2, FeatTypeName As String) As SldWorks.Feature ' parses down the Feature manager manager looking for the first ' passed feature TYPE name
Dim SearchFeat As SldWorks.Feature Dim FeatName As String
' Get the 1st SearchFeat in part Set SearchFeat = SearchDoc.FirstFeature
Do While Not SearchFeat Is Nothing ' While we have a valid SearchFeat FeatName = SearchFeat.GetTypeName ' Get the TYPE name of the SearchFeat If FeatName = FeatTypeName Then ' we found first instance of Feature ' Set FindFeature = SearchFeat ' return the Feature Object Exit Do End If Set SearchFeat = SearchFeat.GetNextFeature() Loop ' Continue until the last SearchFeat is done
Set SearchFeat = Nothing
End Function