---

Hallo zusammen!!

Ich versuche gerade per VBA einen Block(ist das auch das Deutsche Wort?) von meiner Zeichnung zu löschen. Wenn ich das per Makrorecorder aufnehme sieht das so aus:
boolstatus = Part.Extension.SelectByID2("Werkstückkante außen DIN 6784-(-0, 5-0, 2)-1", "SUBSKETCHINST", 0.3460876115816, 0.08213916943522, 0, False, 0, Nothing, 0)
Part.EditDelete

Komischerweise passiert nichts wenn ich das Makro ausführe. Ausserdem möchte ich das sowieso Koordinaten unabhängig machen.
Hat jemand Erfahrung mit dem, oder kann mir sonst jemand helfen?

Liebe Grüsse

-habe SW2011
-Windows 7, 64bit

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

---

Hallo Bigles

Probier mal:

boolstatus = Part.Extension.SelectByID2("Name des Blockes", "SUBSKETCHDEF", 0, 0, 0, False, 0, Nothing, 0)
Part.EditDelete

Gruß Winni

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

---

Hmm, leider nicht! Kommt die gleiche Meldung: "none of the selected enteties could be deleted." Aber trotzdem Danke für den Versuch!
lg

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

---

Hat niemand eine Idee? Ist ziemlich wichtig! 

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

---

Hallo Bigles

Das Problem ist, dass der Block mit jedem neuen Einfügen einen anderen Namen erhällt.

Deshalb würde ich soetwas vorschlagen.
Loop durch alle Blöcke im Featurebaum unter Blöcke,Namen abgleichen, Block Selektieren und Löschen...

Code:

---

Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature
Dim swSketchMgr As SldWorks.SketchManager
Dim swSketchBlockDef As SldWorks.SketchBlockDefinition
Dim vSketchBlockDefs As Variant
Dim vSketchBlockDef As Variant
Dim retval As Variant

Sub main()

    Dim NameDesBlockes As String
    NameDesBlockes = "Werkstüchkante außen DIN 6784-(-0,5-0,2)"

    Set swApp = Application.SldWorks
    Set swDoc = swApp.ActiveDoc
    Set swSketchMgr = swDoc.SketchManager

    vSketchBlockDefs = swSketchMgr.GetSketchBlockDefinitions

    For Each vSketchBlockDef In vSketchBlockDefs
        Set swSketchBlockDef = vSketchBlockDef
        Set swFeat = swSketchBlockDef.GetFeature

        If InStr(swFeat.Name, NameDesBlockes) > 0 Then
            retval = swFeat.Select2(False, -1)
            retval = swDoc.DeleteSelection(False)
        End If
    Next
End Sub

---

Gruss Andreas

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

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

---

Ahh, vielen vielen Dank!!! Jetzt funktioniert es endlich!!! Hatte allerdings noch einen kleinen Fehler. Mit ein bisschen ausprobieren war das aber schnell behoben. Der funktionierende Code wäre:

Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature
Dim swSketchMgr As SldWorks.SketchManager
Dim swSketchBlockDef As SldWorks.SketchBlockDefinition
Dim vSketchBlockDefs As Variant
Dim vSketchBlockDef As Variant
Dim retval As Variant
Sub main()

    Dim NameDesBlockes As String
    NameDesBlockes = "Werkstüchkante außen DIN 6784"

    Set swApp = Application.SldWorks
    Set swDoc = swApp.ActiveDoc
    Set swSketchMgr = swDoc.SketchManager

    vSketchBlockDefs = swSketchMgr.GetSketchBlockDefinitions

    For Each vSketchBlockDef In vSketchBlockDefs
        Set swSketchBlockDef = vSketchBlockDef
        Set swFeat = swSketchBlockDef.GetFeature
        If InStr(swSketchBlockDef.FileName, NameDesBlockes) > 0 Then
            retval = swFeat.Select2(False, -1)
            retval = swDoc.DeleteSelection(False)
        End If
    Next
End Sub

lg Bigles

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

---

ACHTUNG! Sie antworten auf einen Beitrag der älter als 1 Jahr ist!

Zitat:

---

Original erstellt von HenryV:
...

Code:

---

...
        Set swFeat = swSketchBlockDef.GetFeature

        If InStr(swFeat.Name, NameDesBlockes) > 0 Then
            retval = swFeat.Select2(False, -1)
            retval = swDoc.DeleteSelection(False)
        End If
...

---

Gruss Andreas

---

Vielen Dank Andreas, du hast mir wie immer sehr geholfen 

------------------
Klaus

www.al-ko.com | mein Gästebuch

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

---

Hallo Klaus,

wobei die Änderung beim Vergleich auf swSketchBlockDef.FileName, NameDesBlockes auch die umbenannten Exemplare "Block-1", "Block-2" etc erwischt ...

Gruß, Christian

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

---

Zitat:

---

Original erstellt von Christian_W:
Hallo Klaus,

wobei die Änderung beim Vergleich auf swSketchBlockDef.[b]FileName, NameDesBlockes auch die umbenannten Exemplare "Block-1", "Block-2" etc erwischt ...

Gruß, Christian[/B]

---

Das brauche ich jetzt nicht unbedingt, aber zur Sicherheit werd ich's mal damit versuchen, danke dir für den Hinweis!

------------------
Klaus

www.al-ko.com | mein Gästebuch

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

---

Taucht bei uns immer mal auf, wenn jemand das Zeichnungsformat ändert und die Frage nach dem umbenennen der vorhandenen Blöcke falsch beantwortet 

und dann wird es durchgeschleppt ...

Gruß, Christian

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

---

Guten Morgen,

kann mir jemand sagen, ob diese Methode so abgeändert werden kann, dass alle Blöcke in der Zeichnung die nicht genutzt werden gelöscht werden.

Danke für eure Hilfe.

Gruß Udo

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

---

Hallo Udo

Code:

---

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swSketchMgr As SldWorks.SketchManager
Dim swFeat As SldWorks.Feature
Dim swSketchBlockDef As SldWorks.SketchBlockDefinition
Dim vSketchBlockDefs As Variant
Dim vSketchBlockDef As Variant
Dim retval As Variant

Sub main()

    Set swApp = Application.SldWorks
    Set swDoc = swApp.ActiveDoc
    Set swSketchMgr = swDoc.SketchManager

    vSketchBlockDefs = swSketchMgr.GetSketchBlockDefinitions
    If Not IsEmpty(vSketchBlockDefs) Then
        For Each vSketchBlockDef In vSketchBlockDefs
            Set swSketchBlockDef = vSketchBlockDef
            'Debug.Print "Anzahl der Blockinstanzen: " & swSketchBlockDef.GetInstanceCount
            Set swFeat = swSketchBlockDef.GetFeature
            If swSketchBlockDef.GetInstanceCount = 0 Then
                retval = swFeat.Select2(False, -1)
                retval = swDoc.DeleteSelection(False)
                'Debug.Print swFeat.Name & " wurde gelöscht"
            Else
                'Debug.Print swFeat.Name & " wird nicht gelöscht"
            End If
        Next
    End If

End Sub

---

Gruss Andreas

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

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

---

Moin,

Ja, das kann dir jemand sagen
Ja, das geht
...
in dem Beispiel müsste fast alles drin sein
Get_Block_Information_Example

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

---

Danke an alle für die schnelle Antwort.

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

---

Blockauflosen.png

Hallo zusammen,

kann man das gleiche auch in einer Baugruppe?
Ich habe eine Skizze als Block und den möchte ich mit einem Makro auflösen.

siehe auch das Bild.
Die Skizze habe ich auch über ein Makro eingefügt nur löst er mir diese leider nicht auf.

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