Nous avons un script à l’ouverture des mises en plan (et un bouton de macro pour un lancement manuel) pour recharger le fond de plan sur l’ensemble des feuilles d’une mise en plan.
Le fond de plan comporte 3 blocs (cartouche, règle, repère d’orientation).
Je me suis rendu compte que le script qui utilise les API SetUpSheet* et ReloadTemplate, duplique pour chaque feuille les 3 blocs de la mise en plan.
Alors que l’opération manuelle d’ajout de feuille ou de rechargement de fond de plan sur une feuille existante, le système nous invite à choisir de renommer des nouveaux blocs ou d’utiliser les blocs existants, notre script lui, semble répondre automatiquement oui à cette question :
Comment faire pour répondre automatiquement non et ne pas dupliquer les blocs ? Avec quels API et/ou valeurs de paramètres d’API puis-je obtenir le comportement souhaité ?
Nous avons des plans qui peuvent compter jusqu’à 112 pages ; on se retrouve avec 336 blocs dans l’arbre.
Le code en question fait pas mal d’autre choses au niveau Solidworks, SmarTeam et autre qui n’est pas pertinent de partager.
La partie de ce code qui recharge le fond de plan reprend à peu de choses près (paramètres de l’API SetUpSheet) ce qu’on trouve dans l’aide.
Mais voilà le code qui me cause soucis :
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swSheet As SldWorks.Sheet
Dim swView As SldWorks.View
Dim vSheetProps As Variant
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swSheet = swDraw.GetCurrentSheet
vSheetProps = swSheet.GetProperties
Dim size As String
If vSheetProps(0) = 7 Then
'7 = A4 Portrait
templateFormat = "A4.SLDDRT"
size = "A4"
ElseIf vSheetProps(0) = 8 Then
'8 = A3 Paysage
templateFormat = "A3.SLDDRT"
size = "A3"
ElseIf vSheetProps(0) = 9 Then
'9 = A2 Paysage
templateFormat = "A2.SLDDRT"
size = "A2"
ElseIf vSheetProps(0) = 10 Then
'10 = A1 Paysage
templateFormat = "A1.SLDDRT"
size = "A1"
ElseIf vSheetProps(0) = 11 Then
'11 = A0 Paysage
templateFormat = "A0.SLDDRT"
size = "A0"
End If
boolstatus = swModel.SetupSheet5( _
swSheet.GetName, _
vSheetProps(0), _
vSheetProps(1), _
vSheetProps(2), _
vSheetProps(3), _
True, _
templateFormat, _
vSheetProps(5), _
vSheetProps(6), _
"Par défaut", _
True _
)
swSheet.ReloadTemplate False
End Sub
Tu ne peux pas avoir ce choix avec l’API.
Si tu veux éviter tous ces blocs dans ton arbre, alors le plus simple est de le supprimer du fond de plan et fixer les esquisses (ou les coter et cacher les cotes).
Sinon tu peux créer un code qui supprime tous les blocs à part ceux de la première feuille, puis les insérer dans les feuilles suivantes. Cette approche collera au comportement que tu souhaite, mais c’est un peu plus de boulot à coder (quoique…)
Mon collègue de l’informatique semble avoir trouvé une parade ici :
Il en a extrait et « mis en forme » le code ci-dessous qui permet de supprimer les doublons de blocs.
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModelDoc As SldWorks.ModelDoc2
Dim bRet As Boolean
Set swApp = Application.SldWorks
Set swModelDoc = swApp.ActiveDoc
BlocksRepair swModelDoc
bRet = swModelDoc.ForceRebuild3(False)
End Sub
Function BlocksRepair(swModel As SldWorks.ModelDoc2)
Dim swDrawingDoc As SldWorks.DrawingDoc
Dim swSketchManager As SldWorks.SketchManager
Dim swSketchBlockDef As SldWorks.SketchBlockDefinition
Dim swSketchBlockInst As SldWorks.SketchBlockInstance
Dim vSketchBlockOriginalNames As Scripting.Dictionary
Dim vSketchBlockDefs As Variant
Dim vSketchBlockDef As Variant
Dim vBadSketchBlockDefs As Scripting.Dictionary
Dim vBadSketchBlockDef As Variant
Dim vSketchBlockInsts As Variant
Dim vSketchBlockInst As Variant
Dim sBlockFileName As String
Dim sBlockName As String
Dim sBlockDefName As String
Set vSketchBlockOriginalNames = New Scripting.Dictionary
Set vBadSketchBlockDefs = New Scripting.Dictionary
Set swSketchManager = swModel.SketchManager
vSketchBlockDefs = swSketchManager.GetSketchBlockDefinitions
If Not IsEmpty(vSketchBlockDefs) Then
For Each vSketchBlockDef In vSketchBlockDefs
Set swSketchBlockDef = vSketchBlockDef
sBlockFileName = swSketchBlockDef.filename
sBlockName = Mid(sBlockFileName, InStrRev(sBlockFileName, "\") + 1, InStrRev(sBlockFileName, ".") - InStrRev(sBlockFileName, "\") - 1)
sBlockDefName = swSketchBlockDef.GetFeature.Name
If (sBlockDefName = sBlockName) Then
vSketchBlockOriginalNames.Add sBlockDefName, swSketchBlockDef
Else
vBadSketchBlockDefs.Add sBlockDefName, swSketchBlockDef
End If
Next
For Each vBadSketchBlockDef In vBadSketchBlockDefs
Set swSketchBlockDef = vBadSketchBlockDefs(vBadSketchBlockDef)
sBlockFileName = swSketchBlockDef.filename
sBlockName = Mid(sBlockFileName, InStrRev(sBlockFileName, "\") + 1, InStrRev(sBlockFileName, ".") - InStrRev(sBlockFileName, "\") - 1)
sBlockDefName = swSketchBlockDef.GetFeature.Name
vSketchBlockInsts = swSketchBlockDef.GetInstances
If Not IsEmpty(vSketchBlockInsts) And swSketchBlockDef.GetInstanceCount > 0 Then
For Each vSketchBlockInst In vSketchBlockInsts
Set swSketchBlockInst = vSketchBlockInst
If DoesItemExist(vSketchBlockOriginalNames, sBlockName) = True Then
swSketchBlockInst.Definition = vSketchBlockOriginalNames(sBlockName)
End If
Next
End If
Next
End If
End Function
Public Function DoesItemExist(vSketchBlockOriginalNames As Scripting.Dictionary, sBlockName As String) As Boolean
Dim vSketchBlockOriginalName As Variant
DoesItemExist = False
For Each vSketchBlockOriginalName In vSketchBlockOriginalNames.Keys
If sBlockName = vSketchBlockOriginalName Then
DoesItemExist = True
Exit Function
End If
Next
End Function
Après quelque test, on s’aperçois que la macro bug avec des blocs dont le chemin est inexistant ;
Le rechargement de fond de plan prend déjà du temps, mais compléter l’opération avec le nettoyage des blocs, on est pas loin de la minute supplémentaire malheureusement.
Pour compléter/améliorer ce code (au point où on en est en terme de temps d’ouverture, on est plus à qq secondes supplémentaire !), mon collègue et moi cherchons comment identifier et supprimer les blocs grisés (c’est à dire ceux qui ont été supprimer dans et depuis la mise en plan, pas depuis l’arbre FeatureManager).
Est-ce que qqn a déjà automatiser cette opération ?
