Sheet Metal Feature Information

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

Reply to
john_picinich
Loading thread data ...

john snipped-for-privacy@hotmail.com =E4=E6=D4=CA=E5 =C7=D3=CA:

Reply to
farsi

john snipped-for-privacy@hotmail.com =E4=E6=D4=CA=E5 =C7=D3=CA:

what are you doing? why you work on this subject?

Reply to
farsi

PolyTech Forum website is not affiliated with any of the manufacturers or service providers discussed here. All logos and trade names are the property of their respective owners.