WIELKIE PODZIĘKOWANIA dla @m_blt & @Deepak_Gupta za ich nieocenioną pomoc 
Dostosowałem Twoje kody i dodałem utworzenie folderu PLOTS (oryginalnie zastępującego BASE), jeśli go nie ma. Dodałem również tworzenie konfiguracji pochodnych do konfiguracji +SOL+PLOTS (i tworzenie, jeśli nie istnieje).
Oto mój kod:
'----------------------------------------------------------------------
'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
MAKRO sprawdziło się w przypadku montażu z 3 częściami TESTOWYMI:
Ale podczas testowania na innych zestawach mam awarię MACRO od początku:
Nie rozumiem, dlaczego mówi mi, że zmienna nie jest zdefiniowana, skoro w pierwszym teście zadziałała.
A podczas debugowania mówi mi ten wiersz:
Czy masz pojęcie, dlaczego działa z niektórymi częściami, a z innymi nie?
