---

Hallo,

Ich benötige ein Makro um alle Blöcke in einer Zeichnung zu löschen. Einen Code für einen einzelnen Block habe ich hier schon gefunden.

Kann mir da jemand helfen?

Danke

Gruß Pete

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

---

Würde das vielleicht über die Filter lösen. Also erst den Filter auf Blöcke einstellen, danach alles markieren und löschen.

Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swExt As ModelDocExtension

Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swExt = swModel.Extension

swApp.SetSelectionFilter 93, True
swExt.SelectAll
swExt.DeleteSelection2 4

[Diese Nachricht wurde von Klopfer195 am 25. Nov. 2020 editiert.]

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

---

Hallo Pete,

oder wenn Du auch auch gleich die Blockdefinitionen mit löschen möchtest

Sub main()
  Dim swApp As SldWorks.SldWorks
  Dim swModel As SldWorks.ModelDoc2
  Dim skMgr As SldWorks.SketchManager
  Dim pBlock As SldWorks.SketchBlockDefinition
  Dim vBlocks As Variant
  Dim itr As Long
  Dim feat As Feature
 
  Set swApp = Application.SldWorks
  Set swModel = swApp.ActiveDoc
  Set skMgr = swModel.SketchManager
 
  vBlocks = skMgr.GetSketchBlockDefinitions

  If IsEmpty(vBlocks) Then
      Exit Sub
  End If

  For itr = 0 To UBound(vBlocks)
        Set pBlock = vBlocks(itr)
        Set feat = pBlock.GetFeature
        If itr = 0 Then feat.Select (False) Else feat.Select (True)
  Next itr
  swModel.Extension.DeleteSelection2 (0)
   
End Sub

------------------
Grüße
Heinz

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

---

Danke, funktioniert super :-)

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