Wir haben ein Skript beim Öffnen von Zeichnungen (und eine Makroschaltfläche für den manuellen Start), um die Grundkarte auf allen Blättern in einer Zeichnung neu zu laden.
Die Grundkarte besteht aus 3 Blöcken (Kartusche, Lineal, Orientierungsmarkierung).
Ich habe festgestellt, dass das Skript, das die APIs SetUpSheet* und ReloadTemplate verwendet, für jedes Blatt die 3 Blöcke der Zeichnung dupliziert.
Während wir beim manuellen Hinzufügen eines Blattes oder beim Neuladen einer Grundkarte auf einem vorhandenen Blatt vom System aufgefordert werden, zu wählen, ob neue Blöcke umbenannt oder vorhandene verwendet werden sollen, scheint unser Skript diese Frage automatisch mit Ja zu beantworten:
Wie antworte ich automatisch mit Nein und nicht mit Duplikaten? Welche APIs und/oder API-Parameterwerte kann ich verwenden, um das gewünschte Verhalten zu erreichen?
Wir haben Pläne, die bis zu 112 Seiten lang sein können; Am Ende haben wir 336 Blöcke im Baum.
Der fragliche Code führt viele andere Dinge auf Solidworks-, SmarTeam- und anderen Ebenen aus, die für die Freigabe nicht relevant sind. Der Teil dieses Codes, mit dem die Grundkarte neu geladen wird, ist mehr oder weniger derselbe (SetUpSheet-API-Parameter) wie in der Hilfe.
Aber hier ist der Code, der mir Probleme bereitet:
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
Mit der API können Sie diese Wahl nicht haben. Wenn Sie all diese Blöcke in Ihrem Baum vermeiden möchten, ist es am einfachsten, sie aus der Grundkarte zu entfernen und die Skizzen zu korrigieren (oder sie zu bemaßen und die Bemaßungen auszublenden). Andernfalls können Sie einen Code erstellen, der alle Blöcke mit Ausnahme der Blöcke auf dem ersten Blatt entfernt, und sie dann in die folgenden Blätter einfügen. Dieser Ansatz hält sich an das gewünschte Verhalten, aber es ist etwas mehr Arbeit zu programmieren (obwohl...)
Mein Kollege aus der IT scheint hier eine Lösung gefunden zu haben:
Er extrahierte und " formatierte " den untenstehenden Code, der es ermöglicht, doppelte Blöcke zu entfernen.
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
Nach einigen Tests stellen wir fest, dass das Makro Fehler mit Blöcken aufweist, deren Pfad nicht vorhanden ist. Das erneute Laden der Grundkarte nimmt bereits Zeit in Anspruch, aber wenn wir den Vorgang mit der Reinigung der Blöcke abschließen, sind wir leider nicht mehr weit von der zusätzlichen Minute entfernt.
Um diesen Code zu vervollständigen/zu verbessern (an dieser Stelle sind wir in Bezug auf die Öffnungszeit nicht mehr ein paar Sekunden entfernt!), suchen mein Kollege und ich nach Möglichkeiten, ausgegraute Blöcke (d.h. solche, die in und nach der Zeichnung gelöscht wurden, nicht aus dem FeatureManager-Baum) zu identifizieren und zu entfernen.
