Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  SolidWorks
  VBA - Block löschen

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: SOLIDWORKS - DFMXpress
Autor Thema:   VBA - Block löschen (2521 mal gelesen)
Bigles
Mitglied
Student, Technischer Zeichner


Sehen Sie sich das Profil von Bigles an!   Senden Sie eine Private Message an Bigles  Schreiben Sie einen Gästebucheintrag für Bigles

Beiträge: 26
Registriert: 09.03.2012

Solidworks 2012
Windows 7

erstellt am: 27. Apr. 2012 13:11    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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

Winni-two
Mitglied
Ing. Maschb.


Sehen Sie sich das Profil von Winni-two an!   Senden Sie eine Private Message an Winni-two  Schreiben Sie einen Gästebucheintrag für Winni-two

Beiträge: 138
Registriert: 12.03.2010

SW 2018 SP5
Intel Xenon W2135 @3.7GHz
Win 10 64 bit
Graka: Nvidia Quadro P4000
32 GB Ram

erstellt am: 27. Apr. 2012 17:24    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Bigles 10 Unities + Antwort hilfreich

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

Bigles
Mitglied
Student, Technischer Zeichner


Sehen Sie sich das Profil von Bigles an!   Senden Sie eine Private Message an Bigles  Schreiben Sie einen Gästebucheintrag für Bigles

Beiträge: 26
Registriert: 09.03.2012

Solidworks 2012
Windows 7

erstellt am: 27. Apr. 2012 19:41    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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

Bigles
Mitglied
Student, Technischer Zeichner


Sehen Sie sich das Profil von Bigles an!   Senden Sie eine Private Message an Bigles  Schreiben Sie einen Gästebucheintrag für Bigles

Beiträge: 26
Registriert: 09.03.2012

Solidworks 2012
Windows 7

erstellt am: 03. Mai. 2012 21:05    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hat niemand eine Idee? Ist ziemlich wichtig! 

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

HenryV
Mitglied
Konstrukteur, Engineering


Sehen Sie sich das Profil von HenryV an!   Senden Sie eine Private Message an HenryV  Schreiben Sie einen Gästebucheintrag für HenryV

Beiträge: 715
Registriert: 18.05.2005

SolidWorks 2020 x64 SP3.0
Dell Precision 5820
Intel Xeon W-2125 4x4GHz
NVIDIA Quadro P2000 5GB
32GB RAM
2x Dell U2412M, 24" TFT
Windows 10 Enterprise x64 1703
Microsoft Office 365 ProPlus
Microsoft Visual Studio Enterprise 2019

erstellt am: 04. Mai. 2012 12:11    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Bigles 10 Unities + Antwort hilfreich

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

Bigles
Mitglied
Student, Technischer Zeichner


Sehen Sie sich das Profil von Bigles an!   Senden Sie eine Private Message an Bigles  Schreiben Sie einen Gästebucheintrag für Bigles

Beiträge: 26
Registriert: 09.03.2012

Solidworks 2012
Windows 7

erstellt am: 04. Mai. 2012 14:56    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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

KMassler
Ehrenmitglied V.I.P. h.c.
CAD Admin + Mädchen für Alles...



Sehen Sie sich das Profil von KMassler an!   Senden Sie eine Private Message an KMassler  Schreiben Sie einen Gästebucheintrag für KMassler

Beiträge: 2635
Registriert: 06.11.2000

** CSWP 01/2008 **
Endlich Dell Precision 7540 mobile Workstation,
64GB, Quadro RTX 3000;
Noch SWX2016 SP4;
SAP/PLM;
DriveWorks Pro;
Programmierung: VBA, aktuell VB.NET 2017

erstellt am: 05. Okt. 2015 13:36    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Bigles 10 Unities + Antwort hilfreich

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

Christian_W
Ehrenmitglied V.I.P. h.c.
Konstrukteur (Dipl-Ing)


Sehen Sie sich das Profil von Christian_W an!   Senden Sie eine Private Message an Christian_W  Schreiben Sie einen Gästebucheintrag für Christian_W

Beiträge: 2600
Registriert: 04.04.2001

SWX2016sp5 WIN10
(SWX2019 testweise)
proAlpha6.2e00/calinkV9
(Tactonworks)
(Medusa7, NesCAD2010,
solidEdge19) CSWP 12/2015

erstellt am: 06. Okt. 2015 09:55    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Bigles 10 Unities + Antwort hilfreich

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

KMassler
Ehrenmitglied V.I.P. h.c.
CAD Admin + Mädchen für Alles...



Sehen Sie sich das Profil von KMassler an!   Senden Sie eine Private Message an KMassler  Schreiben Sie einen Gästebucheintrag für KMassler

Beiträge: 2635
Registriert: 06.11.2000

** CSWP 01/2008 **
Endlich Dell Precision 7540 mobile Workstation,
64GB, Quadro RTX 3000;
Noch SWX2016 SP4;
SAP/PLM;
DriveWorks Pro;
Programmierung: VBA, aktuell VB.NET 2017

erstellt am: 06. Okt. 2015 12:02    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Bigles 10 Unities + Antwort hilfreich

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

Christian_W
Ehrenmitglied V.I.P. h.c.
Konstrukteur (Dipl-Ing)


Sehen Sie sich das Profil von Christian_W an!   Senden Sie eine Private Message an Christian_W  Schreiben Sie einen Gästebucheintrag für Christian_W

Beiträge: 2600
Registriert: 04.04.2001

SWX2016sp5 WIN10
(SWX2019 testweise)
proAlpha6.2e00/calinkV9
(Tactonworks)
(Medusa7, NesCAD2010,
solidEdge19) CSWP 12/2015

erstellt am: 06. Okt. 2015 13:14    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Bigles 10 Unities + Antwort hilfreich

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

Nobody1976
Mitglied



Sehen Sie sich das Profil von Nobody1976 an!   Senden Sie eine Private Message an Nobody1976  Schreiben Sie einen Gästebucheintrag für Nobody1976

Beiträge: 35
Registriert: 20.05.2014

SWX 2019 SP5.0

erstellt am: 18. Jun. 2020 08:41    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Bigles 10 Unities + Antwort hilfreich

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

HenryV
Mitglied
Konstrukteur, Engineering


Sehen Sie sich das Profil von HenryV an!   Senden Sie eine Private Message an HenryV  Schreiben Sie einen Gästebucheintrag für HenryV

Beiträge: 715
Registriert: 18.05.2005

SolidWorks 2020 x64 SP3.0
Dell Precision 5820
Intel Xeon W-2125 4x4GHz
NVIDIA Quadro P2000 5GB
32GB RAM
2x Dell U2412M, 24" TFT
Windows 10 Enterprise x64 1703
Microsoft Office 365 ProPlus
Microsoft Visual Studio Enterprise 2019

erstellt am: 18. Jun. 2020 09:15    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Bigles 10 Unities + Antwort hilfreich

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

Christian_W
Ehrenmitglied V.I.P. h.c.
Konstrukteur (Dipl-Ing)


Sehen Sie sich das Profil von Christian_W an!   Senden Sie eine Private Message an Christian_W  Schreiben Sie einen Gästebucheintrag für Christian_W

Beiträge: 2600
Registriert: 04.04.2001

SWX2016sp5 WIN10
(SWX2019 testweise)
proAlpha6.2e00/calinkV9
(Tactonworks)
(Medusa7, NesCAD2010,
solidEdge19) CSWP 12/2015

erstellt am: 18. Jun. 2020 09:31    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Bigles 10 Unities + Antwort hilfreich

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

Nobody1976
Mitglied



Sehen Sie sich das Profil von Nobody1976 an!   Senden Sie eine Private Message an Nobody1976  Schreiben Sie einen Gästebucheintrag für Nobody1976

Beiträge: 35
Registriert: 20.05.2014

SWX 2019 SP5.0

erstellt am: 18. Jun. 2020 10:10    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Bigles 10 Unities + Antwort hilfreich

Danke an alle für die schnelle Antwort.

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2020 CAD.de | Impressum | Datenschutz