Macro for creating parts from config

Is there a macro for creating separate parts from configurations of a single
part?

Or maybe it can be done without?

Thanks.

 

Yes, the long way: copy to a new name, delete unwanted configs, and again
for the next one.

HIH
JM

 

I have one. I was on my former website. I will put it back on soon.

kind regards,

JJ

www.studiozwaard.nl

yozotrinity schreef:

 

I found this a while ago, but I've never used it.

'***********************************************************
'Company: CADimensions, Inc.
'Author: Steve Stojanovski ()
'Date: December 4, 2003
'
'Name: SaveConfiguration.swp
'Type: SolidWorks Macro
'Requires: SolidWorks 2003 or greater
'
'Description: Allows you to save each configuration of the
' active SolidWorks part document to its own SolidWorks
' part document. The resulting files get saved
' to the same directory where the original
' SolidWorks part document resides.
'
' Each new document is named as follows:
'
' OriginalFileName (ConfigurationName).sldprt
'
' For example, if we had a Solidworks part document
' named "WASHER.SLDPRT" and had the following configurations:
'
' 2 inch dia
' 4 inch dia
' 6 inch dia
'
' We would end up with three new files in the same directory
' where "WASHER.SLDPRT" resides with the following names:
'
' WASHER (2 inch dia).SLDPRT
' WASHER (4 inch dia).SLDPRT
' WASHER (6 inch dia).SLDPRT
'
' The part "WASHER.SLDPRT" does not get modified in anyway.
' Each new part file will consist of one configuration (i.e
' "2 inch dia").
'
' If the configurations were created using a Design Table,
' the Design Table will be deleted from each new file, but NOT
' the original.
'
' If your configuration names have characters that are invalid
' for creating a filename in Windows, those invalid characters
' will be replaced with a single SPACE character. The following
' is a list of characters that will be replaced:
'
' "/" = forward slash
' "\" = back slash
' "*" = asterisk
' "?" = question mark
' """ = double quote
' "<" = less than
' ">" = greater than
' "|" = bar
'
'
' If you have configuration specific custom properties defined
' for each configuration, those will also exist in each file
' that is created as well.
'
' An example file "Example.sldprt" is included as an example.
' Open the file "Example.sldprt" in SolidWorks and run the macro
' to see the result.
'
'***********************************************************

'Saves each configuration of a SolidWorks Part file to a separate file
with

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim ModelDoc As SldWorks.ModelDoc2
Dim ModelDocCopy As SldWorks.ModelDoc2
Dim strNewFileName As String
Dim ConfigNames As Variant
Dim strActiveConfig As String
Dim nCount As Long
Dim nCountCopy As Long
Dim RetVal As Long


Sub Main()

Set swApp = Application.SldWorks
Set ModelDoc = swApp.ActiveDoc

If Not ModelDoc Is Nothing Then
If ModelDoc.GetType = 3 Then 'document is a drawing, exit sub
MsgBox "Active document is not a SolidWorks part or
assembly!", vbInformation
Exit Sub
End If

If ModelDoc.GetPathName = "" Then 'model not saved
MsgBox "Please save the model!", vbInformation
Exit Sub
End If

'Get all the configurations names into an array
ConfigNames = ModelDoc.GetConfigurationNames

'Get the active configuration so we can switch back to it when
finished
strActiveConfig = ModelDoc.GetActiveConfiguration.Name

For nCount = 0 To UBound(ConfigNames)
'Activate the configuration
ModelDoc.ShowConfiguration2 ConfigNames(nCount)

'Create a filename for the Save as copy
strNewFileName = CreateNewFileName(ModelDoc.GetPathName,
ConfigNames(nCount))
'Debug.Print strNewFileName

'Save a copy of the file
RetVal = ModelDoc.SaveAsSilent(strNewFileName, True)

'Open the new file with the Correct Configuration
Set ModelDocCopy =
swApp.OpenModelConfiguration(strNewFileName, ConfigNames(nCount))

For nCountCopy = 0 To UBound(ConfigNames)
If ConfigNames(nCountCopy) <> ConfigNames(nCount) Then
'Delete each configuration except the one that is
the active one
ModelDocCopy.DeleteConfiguration2
(ConfigNames(nCountCopy))
End If
Next

'Save and close the modelcopy
ModelDocCopy.SaveSilent
swApp.CloseDoc ModelDocCopy.GetPathName
Set ModelDocCopy = Nothing
Next

'Show the configuration that was active when we before we
started
ModelDoc.ShowConfiguration2 strActiveConfig

MsgBox "Finished!", vbInformation

End If


Set ModelDoc = Nothing
Set ModelDocCopy = Nothing
Set swApp = Nothing

End Sub

Function CreateNewFileName(strFileName As String, ByVal strCfgName As
String) As String

Dim objFS As Scripting.FileSystemObject
Dim strBaseName As String
Dim strExt As String
Dim strPath As String
Dim strNewFileName

Set objFS = CreateObject("Scripting.FileSystemObject")

strBaseName = objFS.GetBaseName(strFileName)
strExt = objFS.GetExtensionName(strFileName)
strPath = objFS.GetParentFolderName(strFileName)

'Add the config name to the base name
strBaseName = strBaseName & " (" & strCfgName & ")"
'add the extension
strNewFileName = strBaseName & "." & strExt
'Clean the filename to remove any invalid chars
strNewFileName = CleanFileName(strNewFileName)
'Build the full path
strNewFileName = objFS.BuildPath(strPath, strNewFileName)

'Return the new filename including the full path
CreateNewFileName = strNewFileName

Set objFS = Nothing

End Function

Function CleanFileName(ByVal strFileName As String) As String
Dim InvalidChars As Variant
Dim x As Integer

'Create array of invalid filename chars
InvalidChars = Array("/", "\", "*", "?", "''", "<", ">", "|")

'Loop through the array and replace each instance of the invalid
chars of the string
For x = 0 To UBound(InvalidChars)
strFileName = Replace(strFileName, InvalidChars(x), Space(1), ,
, vbTextCompare)
Next

'Return the filename cleaned and trimmed
CleanFileName = Trim(strFileName)

End Function