anyone know how to insert a sheetmetal unfold using vba? Ifigured out how to collect all the bends gathering all the bendnames then using selectbyid2. But I can not for the life of me getthe fixed face. I would like it setup so the face could be selectedprior to running the macro. attached is my code for getting all thebends (its not pretty right now...) Thanx...
Sub main1()
Dim swApp As SldWorks.SldWorks
Dim swPart As SldWorks.ModelDoc2
Dim swFeature As SldWorks.Feature
Dim nFeatureCount As Long
Dim iCnt As Long
Dim sBendNames() As String
Dim sTemp As String
Set swApp = Application.SldWorks
Set swPart = SldWorks.ModelDoc2
Set swFeature = swPart.FirstFeature
Set swSelMgr = swPart.SelectionManager
nFeatureCount = 0
ReDim sBendNames(nFeatureCount)
' While we have a valid feature
While Not swFeature Is Nothing
' Get the name of the feature
Dim FeatureName As String
Dim FeatureType As String
Dim SubFeat As SldWorks.Feature
Set swFeature = swFeature.GetNextFeature
'a sketch below the flat pattern in the design tree creates
'an error here, counteract that error by double checking Feature
If swFeature Is Nothing Then GoTo Clear
FeatureType = swFeature.GetTypeName
If FeatureType = "FlatPattern" Then
Set SubFeat = swFeature.GetFirstSubFeature
' While we have a valid Sub-feature
While Not SubFeat Is Nothing
' Get the type of the Sub-feature
If SubFeat.GetTypeName = "UiBend" Then
nFeatureCount = nFeatureCount + 1
ReDim Preserve sBendNames(nFeatureCount)
'format the string
sTemp = SubFeat.Name
sTemp = Left(sTemp, (InStr(1, sTemp, ">") - 1))
sTemp = Mid(sTemp, (InStr(1, sTemp, "<") + 1))
sBendNames(nFeatureCount - 1) = sTemp
End If
Set SubFeat = SubFeat.GetNextSubFeature
' Continue until the last Sub-feature is done
Wend
' Get the next feature
Set swFeature = swFeature.GetNextFeature()
' Continue until the last feature is done
End If
Wend
Clear:
For iCnt = 0 To UBound(sBendNames)
Debug.Print sBendNames(iCnt)
boolstatus = swPart.Extension.SelectByID2(sBendNames(iCnt),"BODYFEATURE", 0, 0, 0, True, 4, Nothing, 0)
Next iCnt
swPart.InsertSheetMetalUnfold
End Sub
SW 2007SolidworksApi macros
Sub main1()
Dim swApp As SldWorks.SldWorks
Dim swPart As SldWorks.ModelDoc2
Dim swFeature As SldWorks.Feature
Dim nFeatureCount As Long
Dim iCnt As Long
Dim sBendNames() As String
Dim sTemp As String
Set swApp = Application.SldWorks
Set swPart = SldWorks.ModelDoc2
Set swFeature = swPart.FirstFeature
Set swSelMgr = swPart.SelectionManager
nFeatureCount = 0
ReDim sBendNames(nFeatureCount)
' While we have a valid feature
While Not swFeature Is Nothing
' Get the name of the feature
Dim FeatureName As String
Dim FeatureType As String
Dim SubFeat As SldWorks.Feature
Set swFeature = swFeature.GetNextFeature
'a sketch below the flat pattern in the design tree creates
'an error here, counteract that error by double checking Feature
If swFeature Is Nothing Then GoTo Clear
FeatureType = swFeature.GetTypeName
If FeatureType = "FlatPattern" Then
Set SubFeat = swFeature.GetFirstSubFeature
' While we have a valid Sub-feature
While Not SubFeat Is Nothing
' Get the type of the Sub-feature
If SubFeat.GetTypeName = "UiBend" Then
nFeatureCount = nFeatureCount + 1
ReDim Preserve sBendNames(nFeatureCount)
'format the string
sTemp = SubFeat.Name
sTemp = Left(sTemp, (InStr(1, sTemp, ">") - 1))
sTemp = Mid(sTemp, (InStr(1, sTemp, "<") + 1))
sBendNames(nFeatureCount - 1) = sTemp
End If
Set SubFeat = SubFeat.GetNextSubFeature
' Continue until the last Sub-feature is done
Wend
' Get the next feature
Set swFeature = swFeature.GetNextFeature()
' Continue until the last feature is done
End If
Wend
Clear:
For iCnt = 0 To UBound(sBendNames)
Debug.Print sBendNames(iCnt)
boolstatus = swPart.Extension.SelectByID2(sBendNames(iCnt),"BODYFEATURE", 0, 0, 0, True, 4, Nothing, 0)
Next iCnt
swPart.InsertSheetMetalUnfold
End Sub
SW 2007SolidworksApi macros
