Hi all! I'm quite new to SW API, understanding the structure is very much a work in progress.
The end goal of the code is to iterate through Cut-List-Item folders and rename them to the name of the first body found in the folder after creating a bounding box for each set.
The bounding box creation I've got figured out (courtesy of a script written Matt Martens), but I cannot manage to get the names of the elements in each folder.
Any advise would be fantastic!
------------------------------------------------------------------------------------------------
Dim SwApp As SldWorks.SldWorks
Dim swPart As SldWorks.ModelDoc2
Sub Main()
'Set the application and open document
Set SwApp = Application.SldWorks
Set swPart = SwApp.ActiveDoc
'check for an open document
If swPart Is Nothing Then
SwApp.SendMsgToUser2 "Please open a part file and try again.", swMbInformation, swMbOk
Exit Sub
End If
'check if the open document is a part file
If Not swPart.GetType = 1 Then
SwApp.SendMsgToUser2 "This command only works in .sldprt files.", swMbInformation, swMbOk
Exit Sub
End If
'send message prompt if no bounding boxes were created
If Not createBoundingBox Then
'prompt user for creation of weldment feature and rerun subroutine if yes is selected
If SwApp.SendMsgToUser2("There is no weldment feature in this model." & Chr(13) & _
"Would you like to insert one and continue?", _
swMbQuestion, swMbYesNoCancel) = 6 Then
swPart.FeatureManager.InsertWeldmentFeature
createBoundingBox
End If
End If
'Drop contents of all objects
swPart.ClearSelection2 True
Set SwApp = Nothing
Set swPart = Nothing
End Sub
Function createBoundingBox() As Boolean
Dim swPartExt As SldWorks.ModelDocExtension
Dim swFeat As SldWorks.Feature
Dim swModel As SldWorks.ModelDoc2
Dim swFeat2 As SldWorks.Feature
Dim swSubFeat As SldWorks.Feature
Dim boxCount As Integer
Dim cutListDesc As String
Set swPartExt = swPart.Extension
'loop through all features and update the cut list feature and create
'SW 3D bounding boxes for all cut-list folders
boxCount = 0
Set swFeat = swPart.FeatureByName("Solid Bodies") 'limits swfeat to the Cut List folder
swFeat.GetSpecificFeature2.UpdateCutList
Set swFeat = swFeat.GetFirstSubFeature
While Not swFeat Is Nothing
Debug.Print "swFeat: "; swFeat.Name
Debug.Print " Desc: "; swFeat.Description
Debug.Print " Type: "; swFeat.GetTypeName
boxCount = boxCount + 1
'check for existing bounding and skip if present
Set swSubFeat = swFeat.GetFirstSubFeature
Do While Not swSubFeat Is Nothing
Debug.Print "Subfeat Name: " & swSubFeat.Name
Debug.Print " Desc: " & swSubFeat.Description
Debug.Print " Type: " & swSubFeat.GetTypeName
'If swSubFeat.GetTypeName2 = "3DProfileFeature" Then GoTo nextFeature
Set swSubFeat = swSubFeat.GetNextSubFeature
Debug.Print "Next Feature"
'Debug.Print swSubFeat.Name
Loop
'add 3D bounding box and alter cutlist properties to cut list folders
swFeat.Select2 False, Empty
Debug.Print swFeat.Name
swPartExt.Create3DBoundingBox
swFeat.CustomPropertyManager.Get4 "Description", True, cutListDesc, 0
Debug.Print "cutListDesc: " & cutListDesc
Debug.Print "Feature Name: " & swFeat.Name
If Left(cutListDesc, 5) = "PLATE" Then
'Alter the system created description of non-weldment created bodies
cutListDesc = Replace(cutListDesc, "PLATE, ", "")
cutListDesc = Left(cutListDesc, Len(cutListDesc) - 11) & "Bar Stock"
Debug.Print "cutListDesc: " & cutListDesc
Debug.Print "swFeat.Name: " & swFeat.Name
Debug.Print "swFeat.GetTypeName: " & swFeat.GetTypeName
swFeat.CustomPropertyManager.Add3 "Description", swCustomInfoText, cutListDesc, swCustomPropertyDeleteAndAdd
End If
'add length property as "SW-Length"
swFeat.CustomPropertyManager.Add3 "Length", swCustomInfoText, "SW-Length", swCustomPropertyDeleteAndAdd
Dim boolstatus As Long
'boolstatus = Part.Extension.SelectByID2(swFeat.Name, "SUBWELDFOLDER", 0, 0, 0, False, 0, Nothing, 0)
swFeat.Select2 False, Empty
swFeat.Name = "Test" & boxCount
nextFeature:
Set swFeat = swFeat.GetNextSubFeature
Wend
'drop contents of objects
Set swPartExt = Nothing
Set swFeat = Nothing
Set cutList = Nothing
'set function to true if any bounding boxes were created
If boxCount = 0 Then createBoundingBox = False: Exit Function
createBoundingBox = True
End Function
SolidworksApi/macros