help with split config macro

Hope someone can help me with this.

I am looking for someone to modify a macro for me. I have a macro that I got
of the net about 12 months ago that I am having a problem with. The problem
is that towards the end of the code there is a comment that says the macro
will remove any unused configs in a part when it is run but it doesn't seem
to work. The macro when run saves each config as a new part in the same path
with a new name (name is the config description). I really need these extra
config to be stripped from each new part as the file sizes just get to big
to handle.
Any help would be great as I don't have any idea of coding what so ever.

----------------------------------------------------------------------------
---------------
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Set swApp = Application.SldWorks
Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.ActiveDoc
Dim swConfig As SldWorks.configuration
Set swConfig = swModel.GetActiveConfiguration
Dim fname, ext, current As String
fname = swModel.GetPathName
ext = Mid(fname, InStr(fname, ".")) ' extension with leading dot
fname = Mid(fname, 1, InStr(fname, ".") - 1) ' path + name without
extension
current = swModel.GetActiveConfiguration.name
Dim configs As Variant
configs = swModel.GetConfigurationNames
Dim i As Long
For i = 0 To UBound(configs)
If Not swModel.ShowConfiguration2(configs(i)) Then
Debug.Print ("Could not switch to config " + configs(i))
Else
Dim name As String
name = fname + configs(i) + ext
Dim err As Long
Dim warning As Long
Call swModel.SaveAs4(name, swSaveAsCurrentVersion, _
swSaveAsOptions_Copy + swSaveAsOptions_Silent +
swSaveAsOptions_AvoidRebuildOnSave, _
err, warning)
Dim newdoc As SldWorks.ModelDoc2
Set newdoc = swApp.OpenDoc(name, swDocPART) ' works only for
parts at the moment
If Not (newdoc Is Nothing) Then ' let's remove the unneeded
configs
Dim j As Long
For j = 0 To UBound(configs)
If (i <> j) Then newdoc.DeleteConfiguration (configs(j))
Next j
swApp.CloseDoc (name)
End If
End If
Next i
swModel.ShowConfiguration2 (current) ' revert to current config
End Sub

 

27.10.2004 01:27:00

Hey! This is MY code ! and you (or the person you got the macro from)
removed the header which says :
' SolidWorks macro to save each configuration of the current document
in a separate file
' copyright 2004, DynaBits sàrl Switzerland, all rights reserved
' this code is freely available under the following conditions:
' - it might not be used in commercial products without written
permission
' - DynaBits offers no support, makes no guarantee and endorses no
responsibility about this code
' - THIS HEADER SHOULD NOT BE MODIFIED OR DELETED
' - please send any enhancement, correction or change to
. Thanks!
The extra configs aren't removed when the part has a design table or
the configs are in a hierarchy. I will do it one day, but my macros
aren't free anymore...
Philippe Guglielmetti - www.e-systems.ch

 

Sorry Philippe
Was not aware of the owner of this code, guess I will have to wait for you
enhancements one day.

 

there is a comment that says the macro will remove any unused
Well, it actually DOES remove them, but then the new docs were
closed without saving.

There was also a SWX bug which returns an "error" when trying to
switch to a cfg that is the active one; I just ignore the error
and see if the current cfg is the one I want.

I also took the liberty of hypenating the newly created filename
using the syntax :
OriginalName - Cfg Name.



' ----- snip --------- snip ------------- snip -----------------

Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim newdoc As SldWorks.ModelDoc2
Dim swConfig As SldWorks.Configuration
Dim fname As String, ext As String
Dim current As String
Dim configs As Variant, newConfigs As Variant
Dim i As Long, j As Long
Dim err As Long, warning As Long

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swConfig = swModel.GetActiveConfiguration

fname = swModel.GetPathName
ext = Mid(fname, InStr(fname, ".")) ' extension with leading dot
fname = Mid(fname, 1, InStr(fname, ".") - 1) ' path + name without
Extension
current = swModel.GetActiveConfiguration.name

configs = swModel.GetConfigurationNames
For i = 0 To UBound(configs)
swModel.ShowConfiguration2 (configs(i)) ' ignore return error!

If Not swModel.GetActiveConfiguration.name = (configs(i)) Then
Debug.Print ("Could not switch to config " + configs(i))
Else
Dim name As String
name = fname & "-" & configs(i) & ext

Call swModel.SaveAs4(name, swSaveAsCurrentVersion,
swSaveAsOptions_Copy + swSaveAsOptions_Silent +
swSaveAsOptions_AvoidRebuildOnSave, _
err, warning)

Set newdoc = swApp.OpenDoc(name, swDocPART) ' works only
for parts at the moment
If Not (newdoc Is Nothing) Then ' let's remove the
unneeded configs
' make sure the config we want is current; erase the
rest
newdoc.ShowConfiguration2 (configs(i))
For j = 0 To UBound(configs)
If (i <> j) Then newdoc.DeleteConfiguration
(configs(j))
Next j

Call newdoc.SaveAs4(name, swSaveAsCurrentVersion,
swSaveAsOptions_Copy + swSaveAsOptions_Silent +
swSaveAsOptions_AvoidRebuildOnSave, _
err, warning)
swApp.CloseDoc (name)
Set newdoc = Nothing
End If
End If
Next i

swModel.ShowConfiguration2 (current) ' revert to current config
Set swConfig = Nothing
Set swModel = Nothing
Set swApp = Nothing

End Sub

' --- snip ------------- snip ------------- snip --------------

A couple more things:

1) Philippe Guglielmetti : now we're "even" (My feature hiding code on
your site
was written by me)

2) Now I can go back to acting like an adult. <grin>

3) Paste the following at the top of the code above:

' SolidWorks macro to save each configuration of the current document
in a separate file
' copyright 2004, DynaBits sàrl Switzerland, all rights reserved
' this code is freely available under the following conditions:
' - it might not be used in commercial products without written
permission
' - DynaBits offers no support, makes no guarantee and endorses no
responsibility about this code
' - THIS HEADER SHOULD NOT BE MODIFIED OR DELETED
' - please send any enhancement, correction or change to
. Thanks!