guppy6163
Mechanical
- Feb 13, 2006
- 2
I have about 600 configurations of a part and I need to gernerate DWG's of each configuration (without me watching) I can't seem to find anyhting and my codes suck. Any help would be great.
Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
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