Mamy skrypt podczas otwierania rysunków (i przycisk makra do ręcznego uruchamiania), aby ponownie załadować mapę bazową na wszystkich arkuszach rysunku.
Mapa bazowa składa się z 3 bloków (kaseta, linijka, znacznik orientacji).
Zdałem sobie sprawę, że skrypt, który korzysta z interfejsów API SetUpSheet* i ReloadTemplate, duplikuje dla każdego arkusza 3 bloki rysunku.
Podczas gdy ręczna operacja dodawania arkusza lub ponownego wczytywania mapy bazowej na istniejącym arkuszu, system prosi nas o wybór, czy zmienić nazwę nowych bloków, czy użyć istniejących, nasz skrypt wydaje się automatycznie odpowiadać twierdząco na to pytanie:
Jak automatycznie odpowiadać "nie" i nie duplikować bloków? Których interfejsów API i/lub wartości parametrów interfejsu API mogę użyć, aby osiągnąć pożądane zachowanie?
Mamy plany, które mogą mieć nawet 112 stron; Kończymy z 336 blokami w drzewie.
Kod, o którym mowa, robi wiele innych rzeczy na poziomach Solidworks, SmarTeam i innych, które nie są istotne do udostępniania. Część tego kodu, która ponownie wczytuje mapę bazową, jest mniej więcej taka sama (parametry API SetUpSheet), jak znajduje się w pomocy.
Ale oto kod, który sprawia mi problemy:
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
Nie możesz mieć takiego wyboru w przypadku interfejsu API. Jeśli chcesz uniknąć wszystkich tych bloków w swoim drzewie, najprostszym sposobem jest usunięcie go z mapy bazowej i naprawienie szkiców (lub zwymiarowanie ich i ukrycie wymiarów). W przeciwnym razie można utworzyć kod, który usunie wszystkie bloki z wyjątkiem bloków na pierwszym arkuszu, a następnie wstawi je do kolejnych arkuszy. Takie podejście będzie trzymać się pożądanego zachowania, ale kodowanie wymaga trochę więcej pracy (chociaż...)
Wygląda na to, że mój kolega z IT znalazł tutaj rozwiązanie:
Wyodrębnił i " sformatował " poniższy kod, który pozwala usunąć zduplikowane bloki.
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
Po kilku testach zauważyliśmy, że makra zawierają błędy w blokach, których ścieżka nie istnieje; Przeładowanie mapy bazowej zajmuje już trochę czasu, ale kończąc operację z czyszczeniem bloków, niestety nie jesteśmy daleko od dodatkowej minuty.
Aby ukończyć/ulepszyć ten kod (w tym momencie, jeśli chodzi o czas otwarcia, nie jesteśmy już w odległości kilku sekund!), mój kolega i ja szukamy sposobów na zidentyfikowanie i usunięcie wyszarzonych bloków (tj. tych, które zostały usunięte w rysunku i po nim, a nie z drzewa FeatureManager).
