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
'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

 

äæÔÊå ÇÓÊ:

 

äæÔÊå ÇÓÊ:

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