---

Hallo Zusammen,

ich habe ein Makro zusammengebastelt, welches einen existierenden Block in eine Zeichnung einfügen soll. Soweit alles gut und klappt auch.
Nun soll ein definiertes Attribut mit einem anderen als dem Defaultwert überschrieben werden. Daran scheitert es derzeit.
Vielleicht hat jemand eine Idee, woran es liegen kann.
Hier der Code (Definitionen, Dimensionierungen, ... sind hier nicht dabei):

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set SwSketchMgr = swModel.SketchManager
Set swMathUtil = swApp.GetMathUtility
        pt(0) = 220 / 1000
        pt(1) = 80 / 1000
        pt(2) = 0
Set swMathPoint = swMathUtil.CreatePoint((pt))
Set SwSketchMgr = swModel.SketchManager
Set newBlockDefinition = SwSketchMgr.MakeSketchBlockFromFile(swMathPoint, block_def, False, 1, 0)

newBlockDefinition.SetAttributeValue "Version", rev_act_block

Im EInzelschrittmodus läuft das Ganze durch, bis auf die letzte Zeile, welche dann die Fehlermeldung "Laufzeitfehler '91' - Objektvariable oder With-Blockvariable nicht festgelegt".

Auf Google konnte leider nicht weiterhelfen.

[Diese Nachricht wurde von Mssrs18 am 11. Mai. 2022 editiert.]

[Diese Nachricht wurde von Mssrs18 am 12. Mai. 2022 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Mssrs18

Ohne den Code zu testen.
IMHO ist das Gleichheitszeichnen in der letzten Zeile zu viel.

Code:

---

newBlockDefinition.SetAttributeValue "Version", rev_act_block

---

Gruss Andreas

------------------
21 ist nur die halbe Antwort.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo HenryV,

danke für die Info.
Das war so nicht korrekt hier im Forum, im Programm hatte ich es bereits geändert.
Die Fehlermeldung kommt immer noch.

Gruß
Martin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ich muss das Fragen...

ist rev_act_block auch wirklich ein String?

------------------
HOMEPAGE | SWXTools.de - SWXHelper für SOLIDWORKS
KONTAKT | support@swxtools.de
FACEBOOK | facebook.com/SWXHelper
TWITTER | twitter.com/SWXTools

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

ja, es sind Strings:
Public Sub get_block(block_def As String, rev_act_block As String)

Das Seltsame ist, dass ich in einem Excel diese Methode zur Prüfplangenerierung - Durchnummerierung verwende und es dort seit Jahren zuverlässig läuft.

Gruß
Martin

[Diese Nachricht wurde von Mssrs18 am 12. Mai. 2022 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ich hab es nochmals angeschaut.
Um ein Attribut zu setzten, brauchst du die Blockinstanz. Momentan hast du die Blockdefinition. Block Definitions and Block Instances

Code:

---

...
Dim swBlockInst As SketchBlockInstance
...

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set SwSketchMgr = swModel.SketchManager
Set swMathUtil = swApp.GetMathUtility
        pt(0) = 220 / 1000
        pt(1) = 80 / 1000
        pt(2) = 0
Set swMathPoint = swMathUtil.CreatePoint((pt))
Set SwSketchMgr = swModel.SketchManager
Set newBlockDefinition = SwSketchMgr.MakeSketchBlockFromFile(swMathPoint, block_def, False, 1, 0)

Set swBlockInst = swSketchBlockDef.GetInstances()(0)
swBlockInst.SetAttributeValue "Version", rev_act_block

---

------------------
21 ist nur die halbe Antwort.

[Diese Nachricht wurde von HenryV am 12. Mai. 2022 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Martin,

bist du in der Blockdefinition (ISketchBlockDefinition Interface) was der Name sugerriert oder in der Blockinstanz (ISketchBlockInstance Interface)? Weil die SetAttributeValue Method (ISketchBlockInstance) ist eine Methode des ISketchBlockInstance Objekts und nicht des ISketchBlockDefinition Objekts.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo an alle "Unterstützer",

ich werde mir die Verschläge / Hinweise kommende Woche näher ansehen.

Danke für's erste und ein schönes Wochenende

Martin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Zusammen,

ich habe mir auch mein funktionierendes Beispiel nochmals angesehen (Das Problemkind ist eine Kopie [umso seltsamer]) und ein Bsp. von SWX.

Im Bsp. von SWX:
Set swSketchBlockDef = swSketchMgr.MakeSketchBlockFromSelected(Nothing)

   
    ' Define an insertion point

    nPt(0) = 60# / 1000#

    nPt(1) = 60# / 1000#

    nPt(2) = 0#

    vPt = nPt

    Set swMathPoint = swMathUtil.CreatePoint(vPt)

   
    ' Insert an instance of the block definition

    Set swBlockInst = swSketchMgr.InsertSketchBlockInstance(swSketchBlockDef, swMathPoint, 1, 0)

Hier wird ebenfalls MakeSketchBlockFromSelected die Blockdefinition und anschließend die Instanzierung der Blockdefinition verwendet.
Der einzige Unterschied ist, dass das SWX-Beispiel die Blockdefinition per Code vornimmt und meine Variante auf eine existierende Blockdefinition verweist.

Gruß

Martin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

in deinem oberen Schnippsel sehe ich nichts von einer BlockInstanz sondern nur 2 mal etwas zu einer Blockdefinition.
Entweder hast du den Bereich mit der BkockInstanz nicht mit in den Beitrag kopiert oder er existiert nicht. 

Wenn du den ganzen Code (inkl. Deklarationsteil) den du bereits hast hier Postetst wird eine Fehlersuche viel einfacher.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Zusammen,

hier der aktuelle Stand des Makros.

Public Sub get_block(block_def As String, rev_act_block As String)

Dim swBlockDef                  As SldWorks.SketchBlockDefinition
Dim swBlockInst                 As SldWorks.SketchBlockInstance

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSketchMgr = swModel.SketchManager
Set swMathUtil = swApp.GetMathUtility

        pt(0) = 220 / 1000
        pt(1) = 80 / 1000
        pt(2) = 0
Set swMathPoint = swMathUtil.CreatePoint((pt))

swMathPoint.ArrayData(0) = pt(0)
swMathPoint.ArrayData(1) = pt(1)
swMathPoint.ArrayData(2) = pt(2)

Set swSketchMgr = swModel.SketchManager
Set swBlockDef = swSketchMgr.MakeSketchBlockFromFile(swMathPoint, block_def, False, 0.5, 0)
Set swBlockInst = swSketchMgr.InsertSketchBlockInstance(swBlockDef, swMathPoint, 0.5, -1)

rev_act_block = Left(rev_act_block, 3) & vbCrLf & Right(rev_act_block, 3)

swBlockInst.SetAttributeValue "Version", rev_act_block

End Sub

Was noch nicht funktioniert ist der letzte Schritt, dem Blockattribut "Version", einen anderen Text zuzuordnen. Es erscheint die Fehlermeldung "Laufzeitfehler '91' - Objektvariable oder With-Blockvariable nicht festgelegt".
--> swBlockInst.SetAttributeValue "Version", rev_act_block
 

[Diese Nachricht wurde von Mssrs18 am 20. Mai. 2022 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

versuch es mal mit:

Code:

---

Dim boolRet as Boolean
boolRet = swBlockInst.SetAttributeValue("Version", rev_act_block)

---

Schönes Wochenende 

------------------
==========
Gruß
Andreas
==========

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

Ich glaube es liegt an folgender Zeile:
Set swBlockDef = swSketchMgr.MakeSketchBlockFromFile(swMathPoint, block_def, False, 0.5, 0)

Bekommst du hier einen Wert zurück für swBlockDef?
Bei meinem Versuch bleibt swBlockDef Nothing, darum funktioniert dann auch swBlockInst.SetAttributeValue nicht.

Versuchs mal so:

Code:

---

Public Sub get_block(block_def As String, rev_act_block As String)

Dim swBlockDef                  As SldWorks.SketchBlockDefinition
Dim swBlockInst                As SldWorks.SketchBlockInstance

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSketchMgr = swModel.SketchManager
Set swMathUtil = swApp.GetMathUtility

        pt(0) = 220 / 1000
        pt(1) = 80 / 1000
        pt(2) = 0
Set swMathPoint = swMathUtil.CreatePoint((pt))

swMathPoint.ArrayData(0) = pt(0)
swMathPoint.ArrayData(1) = pt(1)
swMathPoint.ArrayData(2) = pt(2)

Set swSketchMgr = swModel.SketchManager
Set swBlockDef = swSketchMgr.MakeSketchBlockFromFile(swMathPoint, block_def, False, 0.5, 0)

Dim vInstances As Variant
Dim vBlocks As Variant
vBlocks = swSketchmgr.GetSketchBlockDefinitions
Set swBlockDef = vBlocks(0)
vInstances = swBlockDef.GetInstances
Set swBlockInst = vInstances(0)

rev_act_block = Left(rev_act_block, 3) & vbCrLf & Right(rev_act_block, 3)

swBlockInst.SetAttributeValue "Version", rev_act_block

---

Ist natürlich jetzt keine elegante Lösung, da mehrere Blöcke vorhanden sein könnten. Aber vielleicht hilft es dir ja 

Gruss
Manuel

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Manuel,

danke für deine Bemühungen, es funktioniert leider auch nicht.
Ich bin noch am weiteren recherchieren und gespannt, ob sich noch eine Lösung auftut (vermutlich ist die Lösung trivial).

Danke und Gruß

Martin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

ist nach mehreren Versuchen die Blockdefinition evtl schon vorhanden und die Neudefinition schlägt fehl?

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Martin,

du scheintst irgendetwas zu vergessen mit aufzuführen, wenn ich deinen Code anwende läuft er durch mit dem "Problem" das er 2 Blöcke einfügt.
Kannst du bitte zeigen wie du die Sub aufrufst?

Ist bei dir nach der Zeile

Code:

---

Set swBlockDef = swSketchMgr.MakeSketchBlockFromFile(swMathPoint, block_def, False, 0.5, 0)

---

der Block schon eingefügt?

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Zusammen,

vielen Dank für das rege Interesse und die vielen Hinweise.

Ich habe nun ALLES in eine Prozedur gepackt, es funktioniert noch immer nicht. In der Zeile mit "Set swBlockDef =", ist swBlockDef nach dem Durchlauf noch immer 'Nothing'.

Hier der derzeitige Stand:
Private Sub ButtonChangeTable_Click()
    Dim swApp As SldWorks.SldWorks
    Dim swDraw As SldWorks.DrawingDoc
    Dim currentsheet As SldWorks.Sheet
    Dim swModel As SldWorks.ModelDoc2
    Dim swModelDocExtension As ModelDocExtension
    Dim swCustomPropertyManager As CustomPropertyManager
    Dim revTableAnno As SldWorks.RevisionTableAnnotation
    Dim swSketchMgr As SldWorks.SketchManager
    Dim swMathUtil As SldWorks.MathUtility
    Dim swMathPoint As SldWorks.MathPoint
    Dim swBlockDef                  As SldWorks.SketchBlockDefinition
    Dim swBlockInst                As SldWorks.SketchBlockInstance
    Dim pt(3) As Double
    Dim boolstatus As Boolean
    Dim longstatus As Long, longwarnings As Long
    Dim RevTableName
    Dim defaultvalue_location, defaultvalues_file
    Dim fso
    Dim objFile
    Dim rev_act As String
    Dim rev_text(2)
    Dim i, n, ret
    Dim myShell
    Dim WSHShell
   

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
    Set currentsheet = swDraw.GetCurrentSheet
    swDraw.ActivateSheet (currentsheet.GetName)
   
    'Die aktuelle in den benutzerdefinierten Eigenschaften der Zeichnung eingetragene Version holen
    Set swModelDocExtension = swModel.Extension
   
    Set swCustomPropertyManager = swModelDocExtension.CustomPropertyManager("")
   
    rev_act = swCustomPropertyManager.Get("Version")
   
   
    'Prüfen, ob eine Datei mit Eintragungswerten existiert
    defaultvalue_location = "c:\tmp\SWX\"
    defaultvalues_file = "revtext.txt"
   
    'Prüfen, ob das Verzeichnis existiert
    Set fso = CreateObject("Scripting.FileSystemObject")
    If (fso.FolderExists(defaultvalue_location)) Then
        'es gibt nix zu tun
    Else
        Call rev_dir
    End If
   
    'Prüfen, ob die Datei existiert
    If fso.FileExists(defaultvalue_location + defaultvalues_file) Then
        'nix tun
    Else
        Call rev_dir
    End If
   
    'Änderungsinfo einlesen
    Set objFile = fso.OpenTextFile(defaultvalue_location + defaultvalues_file)
    i = 0
    Do Until objFile.AtEndOfStream
        rev_text(i) = objFile.ReadLine
        i = i + 1
    Loop
    objFile.Close
   
    'Prüfen, ob bereits eine Revisionstabelle existiert
    'Set swSheet = swDraw.GetCurrentSheet
    Set revTableAnno = currentsheet.RevisionTable
    'MsgBox revTableAnno.CurrentRevision
    If revTableAnno Is Nothing Then
        'Revisionstabelle einfügen und Version hinzufügen
        Set revTableAnno = currentsheet.InsertRevisionTable2(True, 0#, 0#, swBOMConfigurationAnchor_TopLeft, "d:\Tabellen\Versionstab.sldrevtbt", swRevisionTable_CircleSymbol, True)
       
    Else
        RevTableName = revTableAnno.RevisionTableFeature.GetFeature.Name
        ret = MsgBox("Es existiert bereits eine Revisionstabelle." & vbCrLf & "Soll eine neue Version hinzugefügt werden?", vbYesNo + vbInformation + vbSystemModal, "!!!")
        If ret = vbNo Then
            Exit Sub
        End If
    End If
   
    'Neue Zeile hinzufügen
    'Dokumentenversion holen
   
    revTableAnno.AddRevision (rev_act)
   
    Dim revTableFeat As SldWorks.RevisionTableFeature
    Set revTableFeat = revTableAnno.RevisionTableFeature
   
    'Nameseintrag auf angemeldeten Benutzer setzen
    Dim Zeile_max
    Zeile_max = revTableFeat.GetTableAnnotationCount - 1
   
    Debug.Print "Zeile_max = ", Zeile_max
   
    'Angemeldeten Benutzer holen
    'Dim fs
    Dim wshNetwork
    Dim sUser, sUDomain, sComputer
   
    Set wshNetwork = CreateObject("WScript.Network")
    sUser = wshNetwork.Username
    sUDomain = wshNetwork.UserDomain
    sComputer = wshNetwork.ComputerName
   
    'Debug.Print "Angemeldeter Benutzer: " & sUser
    'Debug.Print "Domain: " & sUDomain
    'Debug.Print "Computer: " & sComputer
    revTableAnno.Text(Zeile_max, 5) = sUser
   
    revTableAnno.Text(Zeile_max, 2) = rev_text(0)
    revTableAnno.Text(Zeile_max, 3) = rev_text(1)
   
    'Änderungskreisle holen
    'Falls Selektion vorhanden, lösen, um den Block nicht an die Selektion zu binden
    swModel.ClearSelection2 True
   
    Dim sBlockPath As String
   
    sBlockPath = "D:\tmp\Rev.SLDBLK"
   
    'Call get_block(sBlockPath, rev_act)
    Set swSketchMgr = swModel.SketchManager
    Set swMathUtil = swApp.GetMathUtility
    Set swBlockDef = swSketchMgr.MakeSketchBlockFromFile(Nothing, sBlockPath, False, 1, 0)
   
    pt(0) = 220 / 1000
    pt(1) = 80 / 1000
    pt(2) = 0#
    Set swMathPoint = swMathUtil.CreatePoint((pt))
   
    swMathPoint.ArrayData(0) = pt(0)
    swMathPoint.ArrayData(1) = pt(1)
    swMathPoint.ArrayData(2) = pt(2)
   
    Set swBlockInst = swSketchMgr.InsertSketchBlockInstance(swBlockDef, swMathPoint, 1, -1)
   
    swModel.GraphicsRedraw2
    Exit Sub
   
    Dim rev_act_block
    rev_act_block = Left(rev_act, 3) & vbCrLf & Right(rev_act, 3)
   
    swBlockInst.SetAttributeValue "Rev", rev_act_block
   
    swModel.GraphicsRedraw2
   
    Set swBlockInst = Nothing
    Set swBlockDef = Nothing
    Set swSketchMgr = Nothing
    Set wshNetwork = Nothing
    Set revTableFeat = Nothing
    Set objFile = Nothing
    Set fso = Nothing
    Set swModelDocExtension = Nothing
    Set swCustomPropertyManager = Nothing
    Set swApp = Nothing
    Set swModel = Nothing
    Set swDraw = Nothing
    Set currentsheet = Nothing
   
    'Formular schließen
    Unload Me
   
End Sub

Gruß

Martin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

also wenn ich deine Variante so nutze egal ob im seperaten Sub oder im gleichen bekomme ich ein "swBlockDef", stimmt der Pfad auch wirklich, weil weiter oben hast du C:\tmp... und für den Block D:\tmp... ist das ein locales Laufwerk oder ein Serverlaufwerk?

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Bernd,

was bedeutet: "bekomme ich ein "swBlockDef"?
Bedeutet das, dass swBlockDef != Nothing ist? Also tatsächlich ein Objekt erstellt wird?

Sorry, für die unterschiedlichen Pfade, das hängt mit unterschiedlichen Tests zusammen.

Das eigentliche Thema ist, dass zwar ein Block eingefügt wird, aber, da kein Objekt erzeugt wird, ein Attribut des Blocks nicht geändert werden kann.
Es scheitert somit an der Stelle:
Set swBlockDef = swSketchMgr.MakeSketchBlockFromFile(Nothing, sBlockPath, False, 1, 0), da swBlockDef = Nothing ist.

Weshalb dann natürlich auch

Set swBlockInst = swSketchMgr.InsertSketchBlockInstance(swBlockDef, swMathPoint, 1, -1)
swBlockInst.SetAttributeValue "Rev", rev_act_block

ohne Auswirkung sind.
Ich hatte heute mit unserem SolidWorks-Distibutor ein Telefonat. Vielleicht findet man kommende Woche Zeit für dieses Thema.
Schauen wir mal was dabei rauskommt.

Gruß
Martin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

skeblodefinvar.avi.txt

Hallo,

zieh doch mal deine Variable ins Überwachungsfenster (siehe Video im Anhang .txt löschen), dann siehst du ob ein Objekt zu dem Zeitpunkt vorhanden ist, wenn ein + kommt, der Wert "leer" bleibt und sich der Typ ändert ist ein Objekt enthalten, da sonst bei Wert Nothing stehen würde.

Mal eine ganz naive Frage, ist die Blockdefinition evtl. in der Zeichnung schon vorhanden (ggf. passiv)? Weil man kann Blockdefinietionen nicht öfter in die Zeichnungen laden (bzw. bekommt man in VBA dann kein Objekt zurück), wenn diese vorher schon in der Zeichnung ist kannst du nur noch neue Instanzen zu der bereits vorhanden Blockdefinition erzeugen.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

SWX_Block.png

Nun kommt etwas Licht ins Dunkel.
Umgang mit Blöcken:
Es gibt die Unterscheidung zwischen Blockdefinition und Blockinstanz, was sicherlich Sinn macht, man aber gut beraten ist, wenn man weiss wie damit umzugehen ist.
Fälle:
1) Es existiert in der Zeichnung im Featurebaum im Ordner Blöcke noch keine Blockdefinition vom einzufügenden Block
- Blockdefinition erstellen 
- https://help.solidworks.com/2020/english/api/sldworksapi/SolidWorks.Interop.sldworks~SolidWorks.Interop.sldworks.ISketchManager_members.html siehe
  Methoden "MakeSketchBlockFrom..."
- Instanz erzeugen und Block ändern (z. B. Text)

2) Es existiert in der Zeichnung im Featurebaum im Ordner Blöcke eine Blockdefinition vom einzufügenden Block
- Block instanziieren --> Set swBlockInst = SwSketchMgr.InsertSketchBlockInstance(swBlockDef, swMathPoint, 0.5, 0)
- swBlockInst.SetAttributeValue "Text", txt_string

Ein Thema habe ich nun doch noch: Wenn keine Blockdefinition existiert und ich den Code unten ausführe, werden 2 Blöcke eingefügt. Ein Block welcher aussieht wie der Block einfach nur eingefügt, ohne Textänderung und ein zweiter Block mit den gewünschten Textänderungen.

Hier der aktuelle Code:

Public Sub get_block(block_def_path As String, block_def_file As String, rev_act As String)
Dim swapp                      As Object
Dim swmodel                    As Object
Dim swDraw                      As Object
Dim SwSketchMgr                As Object
Dim swBlockDef                  As Object
Dim swBlockInst                As SldWorks.SketchBlockInstance
Dim vBlockDef                  As Variant
Dim vBlockInst                  As Variant
Dim vNote                      As Variant
Dim swNote                      As Object
Dim i                        As Integer
Dim blk_status                  As Boolean
Dim rev_act_block
Dim vBlockDef_count

    blk_status = False
 
    Set swapp = CreateObject("SldWorks.Application")
    Set swmodel = swapp.ActiveDoc
    Set swDraw = swmodel
   
    If swDraw Is Nothing Then
      MsgBox "Keine Datei geladen!", vbOKOnly, "Fehler"
      Exit Sub
    End If
   
    If swDraw.GetType <> 3 Then
      MsgBox "Keine Zeichnung geladen!", vbOKOnly, "Fehler"
      Exit Sub
    End If
   
    Set swMathUtil = swapp.GetMathUtility
    Set SwSketchMgr = swmodel.SketchManager
    vBlockDef = SwSketchMgr.GetSketchBlockDefinitions
   
    'Blockeinfügepunkt definieren
    pt(0) = 220 / 1000
    pt(1) = 80 / 1000
    pt(2) = 0#
   
    Set swMathPoint = swMathUtil.CreatePoint((get_Blockpos))
           
    swMathPoint.ArrayData(0) = pt(0)
    swMathPoint.ArrayData(1) = pt(1)
    swMathPoint.ArrayData(2) = pt(2)
       
    'Wenn Blöcke existieren, prüfen, ob bereits eine Blockdefinition zum Änderungsblock existiert
    If Not IsEmpty(vBlockDef) Then
   
        ' für alle Blockdefinitionen
        For i = 0 To UBound(vBlockDef)
            Set swBlockDef = vBlockDef(i)
   
            ' Blockname
            Debug.Print swBlockDef.GetFeature.Name
   
            'Debug.Print Left(block_def_file, InStr(block_def_file, ".") - 1)
            'Wenn der Blockname im Verzeichnis der Blöcke im Featurebaum vorhanden ist
            If swBlockDef.GetFeature.Name = Left(block_def_file, InStr(block_def_file, ".") - 1) Then
                blk_status = True
                Exit For
            End If
        Next i
       
        'Wenn Blockdefinition nicht existiert, Definition einfügen
        If blk_status = True Then
            'nun noch instanziieren und Version aktualisieren, das war's dann
            Set swBlockInst = SwSketchMgr.InsertSketchBlockInstance(swBlockDef, swMathPoint, 0.5, 0)
            rev_act_block = Left(rev_act, 3) & vbCrLf & Right(rev_act, 3)
            swBlockInst.SetAttributeValue "Version", rev_act_block
        Else
            'Keine Blockdefinition vorhanden --> einfügen --> zu sehen im Featurebaum im Ordner Blöcke
            Set swBlockDef = SwSketchMgr.MakeSketchBlockFromFile(Nothing, block_def_path & block_def_file, False, 0.5, 0)
            'Debug.Print swBlockDef.Name
            'nun noch instanziieren und Version aktualisieren, das war's dann
            Set swBlockInst = SwSketchMgr.InsertSketchBlockInstance(swBlockDef, swMathPoint, 0.5, 0)
            Debug.Print swBlockInst.Name
            'Set swBlockInst = SwSketchMgr.EditSketchBlock(swBlockDef)
            rev_act_block = Left(rev_act, 3) & vbCrLf & Right(rev_act, 3)
            swBlockInst.SetAttributeValue "Version", rev_act_block
        End If
    Else
        'MsgBox "Keine Blöcke gefunden!", vbOKOnly, "Meldung"
        'Keine Blockdefinition vorhanden --> einfügen --> zu sehen im Featurebaum im Ordner Blöcke
        Set swBlockDef = SwSketchMgr.MakeSketchBlockFromFile(Nothing, block_def_path & block_def_file, False, 0.5, 0)
        Debug.Print swBlockDef.Name
        'nun noch instanziieren und Version aktualisieren, das war's dann
        Set swBlockInst = SwSketchMgr.InsertSketchBlockInstance(swBlockDef, swMathPoint, 0.5, 0)
        Debug.Print swBlockInst.Name
        'Set swBlockInst = SwSketchMgr.EditSketchBlock(swBlockDef)
        rev_act_block = Left(rev_act, 3) & vbCrLf & Right(rev_act, 3)
        swBlockInst.SetAttributeValue "Version", rev_act_block
    End If
    swmodel.GraphicsRedraw2
End Sub

Vielleicht hat noch jemand einen Tip, wie ich das Thema mit den 2 Blöcken gelöst bekomme?!

Gruß
Martin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

...
Mal eine ganz naive Frage, ist die Blockdefinition evtl. in der Zeichnung schon vorhanden (ggf. passiv)?...

---

so naive Fragen werden nicht beantwortet (hatte ich ja auch schon gestellt)...

Gruß, Christian

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Was ich mit dem Programm mache, ist
- Ist die Blockdefinition vorhanden
  --> Ja --> erstelle eine Instanz
  --> Nein --> Erstelle eine Blockdefinition und dann eine Instanz

Woran erkennt man, ob eine Blockdefinition passiv ist? Mir ist nur bekannt es gibt eine Blockdefinition oder nicht und wenn es eine gibt, existiert eine oder mehrere Instanzen oder nicht.

Gruß
Martin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Martin,

mit passiv meine ich das tatsächlich nur die Blockdefinition schon vorhanden ist, sieht optisch im Ordner so ähnlich aus wie ein nicht aktives Blatt.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Bernd,

es funktioniert fast alles, bis auf das, dass wenn noch keine Blockdefinition vorhanden ist,
a) bei Definition
und
b) bei Instanziierung

ein Block eingefügt wird. Wobei der, welcher bei Definition eingefügt wird, sich verhält, wie "von Hand" eingefügt, es wird also der Text nicht aktualisiert.

Eigentlich ist das Makro soweit ok, wobei es mich stört, dass es nicht ohne das zusätzliche Einfügen bei zusätzlicher Definition geht. Ich finde einfach keine Info, wie dies zu bewerkstelligen ist.

Gruß
Martin

PS: Wenn ein Beitrag erledigt ist, kann man den Beitrag als erledigt kennzeichnen?

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Martin,

das ist doch genau das Problem das ich weiter oben schon mal beschrieben habe, in diesem Fall (also Blockdef = neu) müsstest (könntest) du die Blockdef (bzw. 1. Instanz) gleich an der Richtigen Position mit Winkel und Scale einfügen und dir dann quasi hintenrum analog dem Beispiel "Get Blocks in Drawing Example (VBA)" diese des Blockes holen um das Attribut zu ändern.

EDIT

Code:

---

Set swBlockDef = swSketchMgr.MakeSketchBlockFromFile(swMathPoint, sBlockPath, False, 0.5, -1)

vBlockInst = swBlockDef.GetInstances

Set swBlockInst = vBlockInst(0)

rev_act_block = "25"

swBlockInst.SetAttributeValue "Version", rev_act_block

---

Da beim ersten Einfügen immer die erste Instanz erzeugt wird kann man sich die Schleife aus dem Beispiel sogar sparen und direkt das erste Object aus dem Arry nehmen

/EDIT

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete  

[Diese Nachricht wurde von bk.sc am 09. Jun. 2022 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Bernd,

ich hatte deinen ursprünglichen Hinweis nicht korrekt interpretiert.
Nun ist es wie von dir vorgeschlagen implementiert und FUNKTIONIERT!

Ein dickes Dankeschön an alle, die an der Lösungsfindung unterstützt haben.
Vielleicht kann der eine oder andere den Code verwenden, deshalb hier der finale, getestete und funktionierende Code:

Public Sub get_block(block_def_path As String, block_def_file As String, rev_act As String)
Dim swApp                      As Object
Dim swModel                    As Object
Dim swDraw                      As Object
Dim SwSketchMgr                As Object
Dim swBlockDef                  As Object
Dim swBlockInst                As SldWorks.SketchBlockInstance
Dim vBlockDef                  As Variant
Dim vBlockInst                  As Variant
Dim vNote                      As Variant
Dim swNote                      As Object
Dim i                        As Integer
Dim blk_status                  As Boolean
Dim rev_act_block
Dim vBlockDef_count

    blk_status = False
 
    Set swApp = CreateObject("SldWorks.Application")
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
   
    If swDraw Is Nothing Then
      MsgBox "Keine Datei geladen!", vbOKOnly, "Fehler"
      Exit Sub
    End If
   
    If swDraw.GetType <> 3 Then
      MsgBox "Keine Zeichnung geladen!", vbOKOnly, "Fehler"
      Exit Sub
    End If
   
    Set swMathUtil = swApp.GetMathUtility
    Set SwSketchMgr = swModel.SketchManager
    vBlockDef = SwSketchMgr.GetSketchBlockDefinitions
   
    'Blockeinfügepunkt definieren
    pt(0) = 220 / 1000
    pt(1) = 80 / 1000
    pt(2) = 0#
   
    Set swMathPoint = swMathUtil.CreatePoint((get_Blockpos))
           
    swMathPoint.ArrayData(0) = pt(0)
    swMathPoint.ArrayData(1) = pt(1)
    swMathPoint.ArrayData(2) = pt(2)
       
    'Wenn Blöcke existieren, prüfen, ob bereits eine Blockdefinition zum Änderungsblock existiert
    If Not IsEmpty(vBlockDef) Then
   
        ' für alle Blockdefinitionen
        For i = 0 To UBound(vBlockDef)
            Set swBlockDef = vBlockDef(i)
   
            ' Blockname
            Debug.Print swBlockDef.GetFeature.Name
   
            'Debug.Print Left(block_def_file, InStr(block_def_file, ".") - 1)
            'Wenn der Blockname im Verzeichnis der Blöcke im Featurebaum vorhanden ist
            If swBlockDef.GetFeature.Name = Left(block_def_file, InStr(block_def_file, ".") - 1) Then
                blk_status = True
                Exit For
            End If
        Next i
       
        'Wenn Blockdefinition nicht existiert, Definition einfügen
        If blk_status = True Then
            'nun noch instanziieren und Version aktualisieren, das war's dann
            Set swBlockInst = SwSketchMgr.InsertSketchBlockInstance(swBlockDef, swMathPoint, 0.5, 0)
            rev_act_block = Left(rev_act, 3) & vbCrLf & Right(rev_act, 3)
            swBlockInst.SetAttributeValue "Version", rev_act_block
        Else
            Set swBlockDef = SwSketchMgr.MakeSketchBlockFromFile(swMathPoint, block_def_path & block_def_file, False, 0.5, 0)
            vBlockInst = swBlockDef.GetInstances
            Set swBlockInst = vBlockInst(0)
            rev_act_block = Left(rev_act, 3) & vbCrLf & Right(rev_act, 3)
            swBlockInst.SetAttributeValue "Version", rev_act_block
        End If
    Else
        'Keine Blockdefinition vorhanden --> einfügen --> zu sehen im Featurebaum im Ordner Blöcke
        Set swBlockDef = SwSketchMgr.MakeSketchBlockFromFile(swMathPoint, block_def_path & block_def_file, False, 0.5, 0)
        vBlockInst = swBlockDef.GetInstances
        Set swBlockInst = vBlockInst(0)
        rev_act_block = Left(rev_act, 3) & vbCrLf & Right(rev_act, 3)
        swBlockInst.SetAttributeValue "Version", rev_act_block
    End If
    swModel.GraphicsRedraw2
End Sub

Gruß
Martin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP