Macro for creating parts from config

"yozotrinity" a écrit dans le message de news: egnoma$ol7$ snipped-for-privacy@ss408.t-com.hr...

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

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

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

'*********************************************************** 'Company: CADimensions, Inc. 'Author: Steve Stojanovski ( snipped-for-privacy@cadimensions.com) '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 ' "" = 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