We have a script when opening drawings (and a macro button for manual launch) to reload the basemap on all the sheets in a drawing.
The basemap has 3 blocks (cartridge, ruler, orientation mark).
I realized that the script that uses the SetUpSheet* and ReloadTemplate APIs, duplicates for each sheet the 3 blocks of the drawing.
While the manual operation of adding a sheet or reloading a basemap on an existing sheet, the system prompts us to choose whether to rename new blocks or use existing ones, our script seems to automatically answer yes to this question:
How do I automatically answer no and not duplicate blocks? Which APIs and/or API parameter values can I use to achieve the desired behavior?
We have plans that can be up to 112 pages long; We end up with 336 blocks in the tree.
The code in question does a lot of other things at the Solidworks, SmarTeam and other levels that are not relevant to share. The part of this code that reloads the basemap is more or less the same (SetUpSheet API parameters) as it is found in the help.
But here's the code that causes me problems:
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
You can't have that choice with the API. If you want to avoid all these blocks in your tree, then the easiest way is to remove it from the basemap and fix the sketches (or dimension them and hide the dimensions). Otherwise you can create a code that removes all the blocks except the ones on the first sheet, and then insert them into the following sheets. This approach will stick to the behavior you want, but it's a little more work to code (although...)
My colleague from IT seems to have found a solution here:
He extracted and " formatted " the code below which allows to remove duplicate blocks.
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
After some testing, we notice that the macro bugs with blocks whose path is non-existent; Reloading the basemap already takes time, but completing the operation with the cleaning of the blocks, we are not far from the extra minute unfortunately.
To complete/improve this code (at this point in terms of opening time, we're no longer a few seconds away!), my colleague and I are looking for ways to identify and remove grayed out blocks (i.e. those that have been deleted in and since the drawing, not from the FeatureManager tree).
