Hallo, ich möchte Notizen oder Attribute in VBA-Blöcken oder Instanzen von Blöcken in SolidWorks Zeichnungen lesen und bearbeiten. Ich kann die Blockobjekte oder Blockinstanzen abrufen, aber nach den folgenden Funktionen erstelle ich Fehler: swBlockDef.GetNotes swBlockDef.GetNoteCount mit swBlockDef als SldWorks.BlockDefinition oder swlockInst.GetAnnotation swlockInst.GetAttributes swlockInst.GetAttributeCount swlockInst.GetAttributeValue swlockInst.SetAttributeValue mit swlockInst als SldWorks.BlockInstance
In der Vergangenheit habe ich swBlockDef.GetNotes bereits erfolgreich verwendet, aber jetzt funktioniert es nicht mehr. Hat jemand eine Lösung für mich? Vielen Dank im Voraus
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' OLD BLOCKS: Obsolete and not supported block
' interfaces as of SOLIDWORKS 2007
'Dim swBlockDef As SldWorks.BlockDefinition
'Dim swBlockInst As SldWorks.BlockInstance
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' NEW BLOCKS: New block interfaces as of SOLIDWORKS 2007
Dim swBlockDef As SldWorks.SketchBlockDefinition
Dim swBlockInst As SldWorks.SketchBlockInstance
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Es scheint notwendig, es zu ersetzen durch: SldWorks.SketchBlockDefinition
Ich verwende SldWorks.SketchBlockDefinition und SldWorks.SketchBlockInstance Ich kann die Block- und Blockinstance-Objekte abrufen. Danach habe ich Probleme...
Das bedeutet nicht viel " es funktioniert nicht mehr ":
Haben Sie Fehlermeldungen? Wenn ja, welche + Screenshot.
Welche Änderungen wurden zwischen " es funktioniert " und " es funktioniert nicht mehr " vorgenommen?
Sie haben die aktuelle Version von Solidworks nicht angegeben.
Das Makro, das ich Ihnen vorgeschlagen habe (das mit dem in @Cyril_fübereinstimmt ( ... fiese Kopierer VAS ) funktioniert auf meinem Solidworks 2022 sp4:
Hier ist das Ergebnis...
File = XXXXXXctif_Brosses.SLDDRW
Block definition linked to file? Faux
File name:
Name of block instance: Orientation-3
Block instance(0):
Angle = 0 deg
Scale = 0,7
TextDisplay = 3
------------------------------------
Block definition linked to file? Faux
File name:
Name of block instance: logo revtech-3
Block instance(0):
Angle = 0 deg
Scale = 0,7
TextDisplay = 3
------------------------------------
Hallo Unten ist der Code, den ich für meine Tests verwende Wenn vNote vNote() als sldworks.note ist, stimmt der Laufzeitfehlercode 13 nicht überein Wenn vNote als Variante, ergibt die Zeile vNote = swBlockDef.GetNotes vNote gleich leer Und, die Zeile vNote = swlockInst.GetAttributes, dann Fehlercode ‹ - 670099352 (d80f1868) ›: Fehlerautomatisierung
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim SwSketchMgr As SldWorks.SketchManager
Dim vBlockDef() As SldWorks.BlockDefinition
Dim swBlockDef As SldWorks.BlockDefinition
Dim vBlockInst() As SldWorks.BlockInstance
Dim swlockInst As SldWorks.BlockInstance
Dim vNote As Variant
'Dim vNote() As SldWorks.Note
Dim swNote As SldWorks.Note
Dim i As Long
Dim j As Long
Dim k As Long
Dim Text As String
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set SwSketchMgr = swModel.SketchManager
vBlockDef = SwSketchMgr.GetSketchBlockDefinitions
If Not IsEmpty(vBlockDef) Then
For i = 0 To UBound(vBlockDef)
Set swBlockDef = vBlockDef(i)
Text = swBlockDef.Name
vNote = swBlockDef.GetNotes 'vide ou erreur
If Not IsEmpty(vNote) Then
For j = 0 To UBound(vNote)
swNote = vNote(j)
Text = swNote.GetText
Next
End If
vBlockInst = swBlockDef.GetInstances
If Not IsEmpty(vBlockInst) Then
For j = 0 To UBound(vBlockInst)
Set swlockInst = vBlockInst(j)
Text = swlockInst.Name
vNote = swlockInst.GetAttributes 'Erreur d'exécution '-670099352 (d80f1868)': Erreur Automation
If Not IsEmpty(vNote) Then
For k = 0 To UBound(vNote)
Set swNote = vNote(k)
Text = swNote.TagName
Next
End If
Next
End If
Next i
End If
End Sub
Hallo Also viele Fehler im Code. Nachfolgend finden Sie den korrigierten Code, der funktionieren sollte (funktioniert mit 2024 SP5), der aus dem API-Hilfecode entnommen wurde.
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim SwSketchMgr As SldWorks.SketchManager
Dim vBlockDef As Variant
Dim swBlockDef As SldWorks.SketchBlockDefinition
Dim vBlockInst As Variant
Dim swBlockInst As SldWorks.SketchBlockInstance
Dim vNote As Variant
Dim swNote As SldWorks.Note
Dim i As Long
Dim j As Long
Dim k As Long
Dim Text As String
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set SwSketchMgr = swModel.SketchManager
vBlockDef = SwSketchMgr.GetSketchBlockDefinitions
If Not IsEmpty(vBlockDef) Then
For i = 0 To UBound(vBlockDef)
Set swBlockDef = vBlockDef(i)
vNote = swBlockDef.GetNotes 'vide ou erreur
If Not IsEmpty(vNote) Then
For j = 0 To UBound(vNote)
Set swNote = vNote(j)
Text = swNote.GetText
Next
End If
vBlockInst = swBlockDef.GetInstances
If Not IsEmpty(vBlockInst) Then
For j = 0 To UBound(vBlockInst)
Set swBlockInst = vBlockInst(j)
Text = swBlockInst.Name
vNote = swBlockInst.GetAttributes
If Not IsEmpty(vNote) Then
For k = 0 To UBound(vNote)
Set swNote = vNote(k)
Text = swNote.TagName
Next
End If
Next
End If
Next i
End If
End Sub
Grundsätzlich geht es um das Deklarieren von Variablen, die falsch sind:
Dim vBlockDef() As SldWorks.BlockDefinition
Variablentyp Variant und keine Klammern für den Namen dieser Variablen. Es fehlt ein Satz der Variablen swNote und viele andere.
Hallo Du hast Recht mit den fehlenden Sets auf swNote = vNote(i) Auf der anderen Seite, wenn ich Dim vBlockDef As Variant bin, bekomme ich einen Fehler in der Zeile Set swBlockDef = vBlockDef(i), dass ich bin, wenn Dim vBlockDef() As SldWorks.BlockDefinition
Das Makro @Cyril_f funktioniert auch in Solidworks 2022. Wenn Sie von einem Fehler sprechen, geben Sie bitte dessen Nummer an (oder machen Sie einen Screenshot).
Ich bin in SW2022 sp5.0 Von meiner Seite aus ist es seltsam: Wenn vNote als Variante, dann ist vNote = swBlockDef.GetNotes oder vNote = swlockInst.GetAttributes leer Wenn vNote() As SldWorks.Note, dann erzeugen die gleichen Funktionen einen Laufzeitfehler 13: Typ mismatch
Wir sollten uns die Referenzen (Tools-> References) ansehen. Meine sind diese, aber mein Code enthält verschiedene Makros, die mehr Referenzen benötigen, als für die Anforderungen des Blockmakros erforderlich sind. Dann ist ein weiteres Problem, das mir bereits passiert ist, die Version von VBA, die nicht die richtige ist und macOS-Betriebsfehler erzeugt
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' OLD BLOCKS: Obsolete and not supported block
' interfaces as of SOLIDWORKS 2007
'Dim swBlockDef As SldWorks.BlockDefinition
'Dim swBlockInst As SldWorks.BlockInstance
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' NEW BLOCKS: New block interfaces as of SOLIDWORKS 2007
Dim swBlockDef As SldWorks.SketchBlockDefinition
Dim swBlockInst As SldWorks.SketchBlockInstance
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Ohne Sie beleidigen zu wollen, @Patrick_CHARDON scheinen Sie sich mit variablen Deklarationen nicht sehr wohl zu fühlen. Ich empfehle Ihnen, @Cyril_f zu vertrauen, außerdem funktioniert das Makro mit uns. Was genau möchten Sie als Information von Ihrem Bock bekommen, wir können Ihnen wahrscheinlich helfen, aber wenn wir nicht wirklich wissen, was Sie versuchen zu tun, wird es kompliziert... Und jetzt drehen wir uns im Kreis...
Ich habe keine Datei mit Blöcken aus dem Jahr 2007, daher ist es schwierig, einen Code zu testen, der das Problem lösen würde. Ich kann jedoch einen Code zum Testen bereitstellen
Unterhalb des zu testenden Codes funktioniert auf Blöcken, die auf einer Version höher als 2007 erstellt wurden, wie erklärt auf meiner Seite kein Debugging auf früheren Versionen möglich. @Maclane , ob Sie testen können.
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim SwSketchMgr As SldWorks.SketchManager
Dim vBlockDef As Variant
Dim swBlockDef As SldWorks.SketchBlockDefinition
Dim OldSwBlockDef As SldWorks.BlockDefinition
Dim vBlockInst As Variant
Dim swBlockInst As SldWorks.SketchBlockInstance
Dim OldSwBlockInst As SldWorks.BlockInstance
Dim vNote As Variant
Dim swNote As SldWorks.Note
Dim bOldBlock As Boolean
Dim i As Long
Dim j As Long
Dim k As Long
Dim Text As String
Sub main()
Set swApp = Application.SldWorks
bOldBlock = False
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set SwSketchMgr = swModel.SketchManager
vBlockDef = SwSketchMgr.GetSketchBlockDefinitions
If IsEmpty(vBlockDef) Then
vBlockDef = swDraw.GetBlockDefinitions
bOldBlock = True
End If
If Not IsEmpty(vBlockDef) Then
For i = 0 To UBound(vBlockDef)
If Not bOldBlock Then
Set swBlockDef = vBlockDef(i)
vNote = swBlockDef.GetNotes
vBlockInst = swBlockDef.GetInstances
Else
Set OldSwBlockDef = vBlockDef(i)
vNote = OldSwBlockDef.GetNotes
vBlockInst = OldSwBlockDef.GetBlockInstances
End If
If Not IsEmpty(vNote) Then
For j = 0 To UBound(vNote)
Set swNote = vNote(j)
Text = swNote.GetText
Debug.Print Text
Next
End If
If Not IsEmpty(vBlockInst) Then
For j = 0 To UBound(vBlockInst)
If Not bOldBlock Then
Set swBlockInst = vBlockInst(j)
Text = swBlockInst.Name
Debug.Print Text
vNote = swBlockInst.GetAttributes
Else
Set OldSwBlockInst = vBlockInst(j)
Text = OldSwBlockDef.Name
Debug.Print Text
vNote = OldSwBlockInst.GetAttributes
End If
If Not IsEmpty(vNote) Then
For k = 0 To UBound(vNote)
Set swNote = vNote(k)
Text = swNote.TagName
Debug.Print Text
Next
End If
Next
End If
Next i
End If
End Sub
@Cyril_f scheint Ihr Makro bei alten Blöcken vor 2007 ohne Probleme zu funktionieren. … Auch wenn der Test durch die Tatsache, dass ich in meinen alten Blöcken nicht viele Attribute verwendet habe, etwas verzerrt ist. (Ich hatte damals viel zu viel mit Autocad gelitten...)
Ich habe mir die Freiheit genommen, zu Bildungszwecken ein paar Kommentare zu Ihrem Code hinzuzufügen: ( In Wirklichkeit war es die KI " Perplexity ", die es getan hat. Und das ist die einzige Nutzung von KI, die ich mir bisher erlaube... und selbst dann halluzinieren sie manchmal ...).
' Déclaration des variables liées à l'API SolidWorks
Dim swApp As SldWorks.SldWorks ' Objet principal de l'application SolidWorks
Dim swModel As SldWorks.ModelDoc2 ' Document actif (pièce, assemblage ou mise en plan)
Dim swDraw As SldWorks.DrawingDoc ' Document de type mise en plan
Dim SwSketchMgr As SldWorks.SketchManager ' Gestionnaire des esquisses
Dim vBlockDef As Variant ' Tableau/variant contenant les définitions de blocs
Dim swBlockDef As SldWorks.SketchBlockDefinition ' Définition d’un bloc (mode SketchManager)
Dim OldSwBlockDef As SldWorks.BlockDefinition ' Définition d’un bloc (ancienne interface)
Dim vBlockInst As Variant ' Tableau/variant contenant les instances de blocs
Dim swBlockInst As SldWorks.SketchBlockInstance ' Instance d’un bloc (mode SketchManager)
Dim OldSwBlockInst As SldWorks.BlockInstance ' Instance d’un bloc (ancienne interface)
Dim vNote As Variant ' Tableau/variant contenant les notes
Dim swNote As SldWorks.Note ' Objet note (annotation textuelle)
Dim bOldBlock As Boolean ' Indicateur : True si bloc utilisant l'ancienne API
Dim i As Long ' Compteur boucle externe
Dim j As Long ' Compteur boucle intermédiaire
Dim k As Long ' Compteur boucle interne
Dim Text As String ' Chaîne temporaire pour stocker du texte
Sub main()
' Récupère l'instance active de SolidWorks
Set swApp = Application.SldWorks
' Par défaut, on suppose qu’on utilise la nouvelle API (pas de vieux blocs)
bOldBlock = False
' Récupère le document actif dans SolidWorks
Set swModel = swApp.ActiveDoc
' Force la variable swDraw à être le document actif considéré comme un DrawingDoc
Set swDraw = swModel
' Récupère le gestionnaire d’esquisse (permet d’accéder aux blocs d’esquisse)
Set SwSketchMgr = swModel.SketchManager
' Tente de récupérer les définitions de blocs "nouvelle API" via le SketchManager
vBlockDef = SwSketchMgr.GetSketchBlockDefinitions
' Si aucune définition trouvée, on essaie via l’ancienne méthode pour les mises en plan
If IsEmpty(vBlockDef) Then
vBlockDef = swDraw.GetBlockDefinitions
bOldBlock = True ' Utilisation de l’ancienne API détectée
End If
' Vérifie si on a bien trouvé au moins une définition de bloc
If Not IsEmpty(vBlockDef) Then
' Parcourt l'ensemble des définitions de blocs récupérées
For i = 0 To UBound(vBlockDef)
' En fonction du type de bloc (nouveau ou ancien), on caste dans le bon objet
If Not bOldBlock Then
Set swBlockDef = vBlockDef(i) ' Définition de bloc "nouvelle API"
vNote = swBlockDef.GetNotes ' Récupère toutes les notes associées à ce bloc
vBlockInst = swBlockDef.GetInstances ' Récupère toutes ses instances
Else
Set OldSwBlockDef = vBlockDef(i) ' Définition de bloc "ancienne API"
vNote = OldSwBlockDef.GetNotes
vBlockInst = OldSwBlockDef.GetBlockInstances
End If
' ----- TRAITEMENT DES NOTES ASSOCIÉES AU BLOC -----
If Not IsEmpty(vNote) Then
For j = 0 To UBound(vNote)
Set swNote = vNote(j)
Text = swNote.GetText ' Récupère le texte complet de la note
Debug.Print Text ' Affiche dans la fenêtre d’exécution VBA
Next
End If
' ----- TRAITEMENT DES INSTANCES DE BLOCS -----
If Not IsEmpty(vBlockInst) Then
For j = 0 To UBound(vBlockInst)
If Not bOldBlock Then
Set swBlockInst = vBlockInst(j) ' Instance (nouvelle API)
Text = swBlockInst.Name
Debug.Print Text
vNote = swBlockInst.GetAttributes ' Récupère les attributs (métadonnées) de l’instance
Else
Set OldSwBlockInst = vBlockInst(j) ' Instance (ancienne API)
Text = OldSwBlockDef.Name ' ? Ici : on affiche le nom de la définition, pas de l’instance
Debug.Print Text
vNote = OldSwBlockInst.GetAttributes
End If
' ----- TRAITEMENT DES ATTRIBUTS DE L’INSTANCE -----
If Not IsEmpty(vNote) Then
For k = 0 To UBound(vNote)
Set swNote = vNote(k) ' Ici, un "attribut" est représenté comme un objet Note/Annotation
Text = swNote.TagName ' Récupère le nom de balise (TagName) de l’attribut
Debug.Print Text
Next
End If
Next
End If
Next i
End If
End Sub
Ich habe mir die Freiheit genommen, den Code in beiden Nachrichten zu ändern, weil ich gemerkt habe, dass die letzte Zeile unbrauchbar ist (ich hatte am Anfang mit einer anderen Idee begonnen und es unterlassen, das zu löschen, was nicht mehr nützlich ist). Vielen Dank für den Test und die Hinzufügung von Kommentaren (ich gebe zu, dass ich nicht mehr zu viel zu meinen Codes kommentiere, da ich der einzige bin, der in meinem Unternehmen programmiert) @Patrick_CHARDON , es liegt an Ihnen