HARTELIJK DANK aan @m_blt & @Deepak_Gupta voor hun onschatbare hulp 
Ik heb uw codes aangepast en de aanmaak van de PLOTS-map (oorspronkelijk ter vervanging van BASE) toegevoegd als deze niet bestaat. Ik heb ook het maken van afgeleide configuraties toegevoegd aan de +SOL+PLOTS configuratie (en het maken als het niet bestaat).
Hier is mijn code:
'----------------------------------------------------------------------
'MACRO CREATION DOSSIER/SOUS DOSSIERS PLOTS + CREATION CONFIG/SOUS CONFIGS PLOTS
'----------------------------------------------------------------------
Option Explicit
Sub Main()
Dim swApp As SldWorks.SldWorks
Dim swAssemb As AssemblyDoc
Dim swFeature As Feature
Dim boolstatus As Boolean
Dim swPlotFolder As FeatureFolder
Dim myFeature As Feature
Dim swModel As SldWorks.ModelDoc2
Dim swConfMgr As SldWorks.ConfigurationManager
Dim swConf As SldWorks.Configuration
Dim swDerivConf As SldWorks.Configuration
'----------------------------------------------------------------------
Set swApp = Application.SldWorks
Set swAssemb = swApp.ActiveDoc
' Vérif doc assemblage
If swAssemb.GetType <> swDocASSEMBLY Then
MsgBox "Le document actif n'est pas un assemblage. Veuillez lancer la macro sur un assemblage."
Exit Sub
End If
' Vérif existance dossier 'PLOTS'
Set swFeature = swAssemb.FeatureByName("PLOTS")
If swFeature Is Nothing Then
' Création dossier 'PLOTS' s'il n'existe pas
boolstatus = swAssemb.Extension.SelectByID2("", "FEATUREMANAGER", 0, 0, 0, False, 0, Nothing, 0)
Set swFeature = swAssemb.FeatureManager.InsertFeatureTreeFolder2(swFeatureTreeFolderType_e.swFeatureTreeFolder_EmptyBefore)
swFeature.Name = "PLOTS"
MsgBox "Le dossier 'PLOTS' a été créé.", vbInformation, "Résultat"
End If
' Une fois le dossier 'PLOTS' trouvé ou créé, ajouter les sous-dossiers
boolstatus = swAssemb.Extension.SelectByID2("PLOTS", "FTRFOLDER", 0, 0, 0, False, 0, Nothing, 0)
' Sous-dossier "PLOTS LONGS"
Set myFeature = swAssemb.FeatureManager.InsertFeatureTreeFolder2(swFeatureTreeFolderType_e.swFeatureTreeFolder_EmptyBefore)
myFeature.Name = "PLOTS LONGS"
boolstatus = swAssemb.Extension.ReorderFeature("PLOTS LONGS", swFeature.Name, swMoveLocation_e.swMoveToFolder)
' Sous-dossier "PLOTS COURTS"
Set myFeature = swAssemb.FeatureManager.InsertFeatureTreeFolder2(swFeatureTreeFolderType_e.swFeatureTreeFolder_EmptyBefore)
myFeature.Name = "PLOTS COURTS"
boolstatus = swAssemb.Extension.ReorderFeature("PLOTS COURTS", swFeature.Name, swMoveLocation_e.swMoveToFolder)
' Sous-dossier "PLOTS MISE EN PLAN"
Set myFeature = swAssemb.FeatureManager.InsertFeatureTreeFolder2(swFeatureTreeFolderType_e.swFeatureTreeFolder_EmptyBefore)
myFeature.Name = "PLOTS MISE EN PLAN"
boolstatus = swAssemb.Extension.ReorderFeature("PLOTS MISE EN PLAN", swFeature.Name, swMoveLocation_e.swMoveToFolder)
' Mise à jour FeatureManager
swAssemb.FeatureManager.UpdateFeatureTree
'----------------------------------------------------------------------
'Traitement de configurations
Set swModel = swApp.ActiveDoc
Set swConfMgr = swModel.ConfigurationManager
' Vérifier si la configuration cible existe
Set swConf = swModel.GetConfigurationByName("+SOL+PLOTS")
If swConf Is Nothing Then
' Créer la configuration +SOL+PLOTS si elle n'existe pas
Set swConf = swConfMgr.AddConfiguration("+SOL+PLOTS", "Configuration principale pour les PLOTS", "", 0, "", "")
If swConf Is Nothing Then
MsgBox "Impossible de créer la configuration '+SOL+PLOTS'.", vbCritical
Exit Sub
Else
MsgBox "La configuration '+SOL+PLOTS' a été créée avec succès.", vbInformation
End If
End If
' Vérifier si la configuration dérivée existe déjà
Set swDerivConf = swModel.GetConfigurationByName("PLOTS COURTS")
If Not swDerivConf Is Nothing Then
MsgBox "La configuration dérivée 'PLOTS COURTS' existe déjà.", vbInformation
Exit Sub
End If
' Créer les configurations dérivées
Set swDerivConf = swConfMgr.AddConfiguration("PLOTS COURTS", "Configuration dérivée de +SOL+PLOTS", "", 1, swConf.Name, "")
Set swDerivConf = swConfMgr.AddConfiguration("PLOTS LONGS", "Configuration dérivée de +SOL+PLOTS", "", 1, swConf.Name, "")
' Vérifier si la configuration a été créée
If swDerivConf Is Nothing Then
MsgBox "Échec de la création de la configuration dérivée.", vbCritical
Else
MsgBox "Configurations dérivées 'PLOTS COURTS' et 'PLOTS LONGS' créées avec succès.", vbInformation
End If
''' Activation de la config +SOL+PLOTS
boolstatus = swModel.ShowConfiguration2("+SOL+PLOTS")
MsgBox "DOSSIER + SOUS-DOSSIERS PLOTS A JOUR - CONFIG + SOUS-CONFIG PLOTS A JOUR.", vbInformation, "Résultat"
End Sub
De MACRO werkte goed in het geval van een assemblage met 3 TEST-onderdelen:
Maar tijdens het testen op andere assemblages, heb ik vanaf het begin een MACRO-crash:
Ik begrijp niet waarom hij me vertelt dat een variabele niet is gedefinieerd terwijl het bij de eerste test wel werkte.
En bij het debuggen vertelt het me deze regel:
Heb je enig idee waarom het met sommige onderdelen werkt en niet met andere?
