Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  SolidWorks
  VBA Linien mit bestimmten Layer 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: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für SOLIDWORKS
  
From the idea to the real part: Everything with one platform - SOLIDWORKS makes it possible
Autor Thema:  VBA Linien mit bestimmten Layer löschen (1751 mal gelesen)
wemasb
Mitglied
Quereinsteiger


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

Beiträge: 124
Registriert: 10.09.2012

SolidWorks 2018
Office 2010
AutoCAD 2007

erstellt am: 19. Jun. 2019 08:19    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

Guten Morgen,

ich bin auf der Suche nach einer Möglichkeit in meiner Zeichnung alle Linien die auf einem bestimmten Layer liegen zu löschen. Auf meiner Suche bin ich auf ein Beispiel Makro gestoßen, dass alle Bezugshinweise aller Zeichenansichten durchgeht und falls diese auf einem bestimmten Layerliegen gelöscht werden:


Option Explicit

' Name of layer from which to delete DELETE ME NOTE note
Const DeleteLayer              As String = "DEL ME"

Sub main()
    Dim swApp                  As SldWorks.SldWorks
    Dim swModel                As SldWorks.ModelDoc2
    Dim swModelDocExt          As SldWorks.ModelDocExtension
    Dim swDraw                  As SldWorks.DrawingDoc
    Dim swSelMgr                As SldWorks.SelectionMgr
    Dim swView                  As SldWorks.View
    Dim swAnn                  As SldWorks.Annotation
    Dim swSelData              As SldWorks.SelectData
    Dim NumShts                As Long
    Dim bRet                    As Boolean
    Dim i                      As Long
   
    Set swApp = CreateObject("SldWorks.Application")
    Set swModel = swApp.ActiveDoc
    Set swModelDocExt = swModel.Extension
    Set swDraw = swModel
    Set swSelMgr = swModel.SelectionManager
    Set swSelData = swSelMgr.CreateSelectData
   
    NumShts = swDraw.GetSheetCount
    For i = 1 To NumShts
        swDraw.SheetPrevious
    Next i
   
    For i = 1 To NumShts
        ' Clear the selection set for the sheet
        swModel.ClearSelection2 True
       
        Set swView = swDraw.GetFirstView
        While Not swView Is Nothing
            Set swAnn = swView.GetFirstAnnotation3
            While Not swAnn Is Nothing
                ' If the annotation is a note, then determine
                ' if the layer is DEL ME
                If swNote = swAnn.GetType Then
                    If DeleteLayer = swAnn.Layer Then
                        ' If the layer is the DEL ME layer
                        ' then select the notes residing
                        ' on that layer
                        bRet = swAnn.Select3(True, swSelData)
                    End If
                End If
                               
                Set swAnn = swAnn.GetNext3
            Wend
           
            Set swView = swView.GetNextView
        Wend
       
        ' Delete the selected notes on the DEL ME layer
        bRet = swModelDocExt.DeleteSelection2(swDelete_Absorbed)
       
        swDraw.SheetNext
    Next i
End Sub

Nur entweder ist es noch zu früh oder weil ich noch keinen Kaffe hatte oder woran auch immer... aber ich kriege es gerade nicht gebacken, es so umzuschreiben wie ich es brauche 

Danke schon mal für jede Art von Hilfe

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: 2675
Registriert: 06.11.2000

SolidWorks Start 1999
** CSWP 01/2008 **
------------------
Zuletzt beruflich:
- SWX2020 SP5;
- SAP/PLM+ECTR;
- DriveWorks Pro;
- Programmierung:
VBA, aktuell Visual Studio 2022/VB.Net
------------------
ab 2024 (privat):
Onshape und anderes

erstellt am: 25. Jun. 2019 13:37    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 wemasb 10 Unities + Antwort hilfreich

Redest du nur von Skizzenlinien, Mittellinien etc.?
Oder von Körperkanten? Diese lassen sich nicht einzeln bestimmten Layern zuordnen sondern immer nur das komplette Modell. Und Körperkanten können auch nicht gelöscht werden, höchstens ausgeblendet.

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

http://www.alko-tech.com | mein Gästebuch

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

bk.sc
Ehrenmitglied V.I.P. h.c.
Konstrukteur Sondermaschinenbau



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

Beiträge: 2776
Registriert: 18.07.2012

-Solid Works 2019 SP5
-Pro Engineer WF 3

erstellt am: 25. Jun. 2019 14:37    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 wemasb 10 Unities + Antwort hilfreich

Hallo,

wie schon im anderen Thread von mir geschrieben.

Zitat:

Mit GetLines4 Method (IView) bekommst du die Linien in einer Ansicht die selber Skizziert sind
Mit GetPolylines7 Method (IView) bekommst du die Linien in einer Ansicht die aus dem Model sind

Du bekommst jeweil ein Arry das du dann auseinandernehmen müsstest.


In diesem Arry steckt auch die LayerID, zu dieser LayerID kannst du dir dann über den Layer-Manager und GetLayerById Method (ILayerMgr) das ILayer Objekt holen und hiervon dann die Name Property (ILayer) um diese abzugleichen.

Alternativ könntest du vielleicht auch direkt über den Layer-Manager gehen und dir über GetItems Method (ILayer) die Skizzensegmente (swLayerItemsOption_SketchSegments) holen und dann löschen.

EDIT: Der Alternative Weg funktioniert leider nicht da ich die Segement nicht so selektiert bekomme das ich diese löschen könnte, es fehlt dann im das Aktiv sein der Ansicht von welcher die Skizze gelöscht werden muss.

Gruß
Bernd

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

Staatlich anerkannte Deutschniete  

[Diese Nachricht wurde von bk.sc am 25. Jun. 2019 editiert.]

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

bk.sc
Ehrenmitglied V.I.P. h.c.
Konstrukteur Sondermaschinenbau



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

Beiträge: 2776
Registriert: 18.07.2012

-Solid Works 2019 SP5
-Pro Engineer WF 3

erstellt am: 25. Jun. 2019 19:33    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 wemasb 10 Unities + Antwort hilfreich

Hallo,

nach einer schweren Geburt  hier das Makro das alle bzw. nur Skizzensegmente die auf einem Layer (derzeit "DEL ME") liegen aus allen Ansichten des aktiven Blattes löscht. Hierfür musste ich von GetLines4 Method (IView) auf GetSketchSegments Method (ISketch) umschwenken um nicht nur Linien sonder auch Spline, Kreise etc. mit zu erfassen.

Code:
Option Explicit

Sub main()

    Dim swApp                      As SldWorks.SldWorks
    Dim swModel                    As SldWorks.ModelDoc2
    Dim swModelDocExt              As SldWorks.ModelDocExtension
    Dim swDrawingDoc                As SldWorks.DrawingDoc
   
    Dim vSktSgArr                  As Variant
    Dim vSktSg                      As Variant
    Dim swSktSg                    As SldWorks.SketchSegment
    Dim swSketch                    As SldWorks.Sketch
   
    Dim swSelData                  As SldWorks.SelectData
   
    Dim vViewsArr                  As Variant
    Dim vView                      As Variant
    Dim swView                      As SldWorks.View
   
    Dim swsheet                    As SldWorks.Sheet
   
    Dim boolstatus                  As Boolean
   
    Const sDelLayer As String = "DEL ME"
   
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDrawingDoc = swModel
    Set swsheet = swDrawingDoc.GetCurrentSheet
    Set swModelDocExt = swModel.Extension

    vViewsArr = swsheet.GetViews
   
    For Each vView In vViewsArr

    Set swView = vView
    Set swSketch = swView.GetSketch
       
    vSktSgArr = swSketch.GetSketchSegments
           
        If IsArray(vSktSgArr) Then
       
        swModel.ClearSelection2 (True)
        boolstatus = swDrawingDoc.ActivateView(swView.Name)
            For Each vSktSg In vSktSgArr
            Set swSktSg = vSktSg
                If swSktSg.Layer = sDelLayer Then
                    boolstatus = swSktSg.Select4(True, swSelData)
                End If
            Next
            swModel.EditDelete
        End If
    Next

End Sub


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

wemasb
Mitglied
Quereinsteiger


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

Beiträge: 124
Registriert: 10.09.2012

SolidWorks 2018
Office 2010
AutoCAD 2007

erstellt am: 26. Jun. 2019 07: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

Das ist der super Bernd, vielen Dank.

Gerade getestet, funktioniert eindwandfrei.

Jetzt stell sich mir nur die Frage... was ist wenn jemand so unklug war und NICHT innerhalb einer Zeichenansicht skizziert hat?
Das Makro geht ja wirklich nur die Zeichenansichten durch 

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: 3189
Registriert: 04.04.2001

CSWP 12/2015<P>SWX2021sp5 Win10/11
(SWX2016, SWX2012)
proAlpha6.2e00/calinkV9
(Tactonworks)
(Medusa7, NesCAD2010,
solidEdge19)

erstellt am: 26. Jun. 2019 09:30    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 wemasb 10 Unities + Antwort hilfreich

Zitat:
… Das Makro geht ja wirklich nur die Zeichenansichten durch  

hast du es mal probiert?

bei drawingdoc.getviews steht

Zitat:
The return value is an array of arrays with a length equal to the number of sheets in the drawing document. Each of those arrays is a list of views with the first view in the list being the sheet itself.


bei sheet.getviews steht das zwar nicht in der Hilfe, ich würd aber mal annehmen, dass es sich da auch so verhält.
Gruß, Christian

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

wemasb
Mitglied
Quereinsteiger


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

Beiträge: 124
Registriert: 10.09.2012

SolidWorks 2018
Office 2010
AutoCAD 2007

erstellt am: 26. Jun. 2019 13:28    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

Klar hab ich das probiert 

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

bk.sc
Ehrenmitglied V.I.P. h.c.
Konstrukteur Sondermaschinenbau



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

Beiträge: 2776
Registriert: 18.07.2012

-Solid Works 2019 SP5
-Pro Engineer WF 3

erstellt am: 26. Jun. 2019 16:49    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 wemasb 10 Unities + Antwort hilfreich

Hallo Christian,

Zitat:
bei sheet.getviews steht das zwar nicht in der Hilfe, ich würd aber mal annehmen, dass es sich da auch so verhält.

hier steht im Arry tatsächlich nicht das Sheet selber drin nur alle erstellten Ansichten auf dem Sheet.

Hallo wemasb

Ich hab jetzt mal das DrawingDoc.GetViews Beispiel aus der API-Hilfe mit meinem Macro verwurstet und es scheint zu funktionieren. Ich hatte einfach keinen Muse mehr mein Macro von Sheet.GetViews auf DrawingDoc.GetViews umzumodeln.
Vorteil jetzt ist das natürlich alle vorhandenen Blätter behandelt werden.

Code:
Option Explicit

Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swDrawDoc As SldWorks.DrawingDoc

Dim swView As SldWorks.View

Dim vSktSgArr As Variant
Dim vSktSg As Variant
Dim swSktSg As SldWorks.SketchSegment
Dim swSketch As SldWorks.Sketch
   
Dim swSelData As SldWorks.SelectData
   
Dim sheetCount As Long

Dim viewCount As Long
 
Dim boolstatus As Boolean

Const sDelLayer As String = "DEL ME"

Sub main()

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

Set swDrawDoc = swModel

Dim viewCount As Long

viewCount = swDrawDoc.GetViewCount

Dim ss As Variant

ss = swDrawDoc.GetViews

For sheetCount = LBound(ss) To UBound(ss)

    Dim vv As Variant

    vv = ss(sheetCount)

    For viewCount = LBound(vv) To UBound(vv)

    Set swView = vv(viewCount)

    Set swSketch = swView.GetSketch
       
    vSktSgArr = swSketch.GetSketchSegments
           
        If IsArray(vSktSgArr) Then
       
        swModel.ClearSelection2 (True)
        boolstatus = swDrawDoc.ActivateView(swView.Name)
            For Each vSktSg In vSktSgArr
            Set swSktSg = vSktSg
                If swSktSg.Layer = sDelLayer Then
                    boolstatus = swSktSg.Select4(True, swSelData)
                End If
            Next
            swModel.EditDelete
        End If

    Next viewCount

Next sheetCount

End Sub


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

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: 3189
Registriert: 04.04.2001

CSWP 12/2015<P>SWX2021sp5 Win10/11
(SWX2016, SWX2012)
proAlpha6.2e00/calinkV9
(Tactonworks)
(Medusa7, NesCAD2010,
solidEdge19)

erstellt am: 26. Jun. 2019 19: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 wemasb 10 Unities + Antwort hilfreich

Zitat:
Original erstellt von wemasb:
Klar hab ich das probiert  

Asche auf mein Haupt …

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: 3189
Registriert: 04.04.2001

CSWP 12/2015<P>SWX2021sp5 Win10/11
(SWX2016, SWX2012)
proAlpha6.2e00/calinkV9
(Tactonworks)
(Medusa7, NesCAD2010,
solidEdge19)

erstellt am: 26. Jun. 2019 19:28    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 wemasb 10 Unities + Antwort hilfreich

Zitat:
Original erstellt von bk.sc:
... und es scheint zu funktionieren.

Vorteil jetzt ist das natürlich alle vorhandenen Blätter behandelt werden.


Hallo Bernd,

danke dass du aufpasst … ;)
bei mir (swx2016) scheint es sich aber bei nicht aktiven Blättern zu sperren.
habe mal dein Makro noch etwas weiter verwurstet (einfach alles mit for each)
aber noch ohne Sicherheitsabfrage, ob denn eine Zeichnung geöffnet ist ...
was haltet ihr von der Version?

Gruß, Christian

Code:
Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDrawDoc As SldWorks.DrawingDoc
Dim swSketch As SldWorks.Sketch
Dim swSelData As SldWorks.SelectData
Dim activeSheet As SldWorks.Sheet

Dim vSktSgArr As Variant
Dim vSktSg As Variant
Dim vSheetsArr As Variant  'array of array of sldworks.view
Dim vViewsArr As Variant    'array of sldworks.view
Dim vView As Variant        'sldworks.view
   
Dim boolstatus As Boolean

Const sDelLayer As String = "DEL ME"

Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDrawDoc = swModel
    Set activeSheet = swDrawDoc.GetCurrentSheet
    vSheetsArr = swDrawDoc.GetViews            'liefert Array(Blaetter) of array(View)
    For Each vViewsArr In vSheetsArr            'fuer jedes Blatt ...
        boolstatus = swDrawDoc.ActivateSheet(vViewsArr(0).Name)
        For Each vView In vViewsArr            'fuer jede Ansicht
            Set swSketch = vView.GetSketch
            vSktSgArr = swSketch.GetSketchSegments
            If IsArray(vSktSgArr) Then
                swModel.ClearSelection2 (True)
                boolstatus = swDrawDoc.ActivateView(vView.Name)
                For Each vSktSg In vSktSgArr    'fuer jedes Skizzenelement
                    If vSktSg.Layer = sDelLayer Then
                        boolstatus = vSktSg.Select4(True, swSelData)
                    End If
                Next 'element
                swModel.EditDelete
            End If
        Next 'view
    Next 'sheet
    boolstatus = swDrawDoc.ActivateSheet(activeSheet.GetName)
End Sub



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

bk.sc
Ehrenmitglied V.I.P. h.c.
Konstrukteur Sondermaschinenbau



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

Beiträge: 2776
Registriert: 18.07.2012

-Solid Works 2019 SP5
-Pro Engineer WF 3

erstellt am: 26. Jun. 2019 19:54    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 wemasb 10 Unities + Antwort hilfreich

Hallo Christian,

danke für das optimieren, ich hab wie gesagt nur schnell (ca. 5 Min.) das Beipiel genommen und den Bereich aus meinem Macro (der für mich das Aufwändigste war zum rausfinden ca. 3h) rein kopiert und angepasst, ich würde normalerweise keine Variablen wie ss/vv verwenden, da stellen sich mir die Nackenhaare auf (Ausnahme sind hier vielleicht Skripts oder Stringoperationen)  .

Der Part mit dem Aktivieren der Sheets ist mir einfach durchgerutsch, weil ich einfach keine Multisheet Zeichnungen habe, das nötig sein des Aktivieren der einzelnen Sheets ist natürlich logisch, Asche auf mein Haupt  .

wemasb sollte jetzt Glücklich sein, er hat mt wenig Information viel Macro bekommen 

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

wemasb
Mitglied
Quereinsteiger


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

Beiträge: 124
Registriert: 10.09.2012

SolidWorks 2018
Office 2010
AutoCAD 2007

erstellt am: 27. Jun. 2019 07: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

Ich liebe dieses Forum einfach, danke Jungs     

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: 3189
Registriert: 04.04.2001

CSWP 12/2015<P>SWX2021sp5 Win10/11
(SWX2016, SWX2012)
proAlpha6.2e00/calinkV9
(Tactonworks)
(Medusa7, NesCAD2010,
solidEdge19)

erstellt am: 27. Jun. 2019 09:39    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 wemasb 10 Unities + Antwort hilfreich

Zitat:
danke für das optimieren ...

hat mich halt gejuckt, nach meiner schlecht recherchierten Antwort vorher ..  
optimal ist es sicher auch nicht geworden -
vSheetsArr ist doch ein irreführender Name - weil, ist ja gar kein Array of Sheets - und könnte sich beißen, wenn da ein echtes Array of sheets parallel benötigt wird.

aber vielleicht kann auch jemand anders dieses Durchgehen der Views gebrauchen …


Edit: Hier nochmal mit besser(?) benannten Arrays und dem Hinweis auf die nicht berücksichtigen Blöcke und Körperkanten.
Wenn benötigt kann sich ja jemand um eine Ergänzung Gedanken machen … ;)

Code:

Option Explicit

'Stand 2019-06-27
'loescht alle gezeichneten Linien auf einem benannten Layer
'aus allen Blaettern und Ansichten
'offen: ganze Bloecke und Linien in Bloecken
'offen: ganze Ansichten oder Koerperkanten

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDrawDoc As SldWorks.DrawingDoc
Dim swSketch As SldWorks.Sketch
Dim swSelData As SldWorks.SelectData
Dim activeSheet As SldWorks.Sheet

Dim vSktSgArr As Variant        'array of sketchsegment
Dim vSktSg As Variant          'sketchsegment
Dim vAllViewsArr As Variant    'array of array of sldworks.view
Dim vSheetViewsArr As Variant  'array of sldworks.view
Dim vView As Variant            'sldworks.view
   
Dim boolstatus As Boolean

Const sDelLayer As String = "Delete me"

Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDrawDoc = swModel
    Set activeSheet = swDrawDoc.GetCurrentSheet
    vAllViewsArr = swDrawDoc.GetViews                  'liefert Array( Array (View))
    For Each vSheetViewsArr In vAllViewsArr            'fuer jedes Blatt ...
        boolstatus = swDrawDoc.ActivateSheet(vSheetViewsArr(0).Name)
        For Each vView In vSheetViewsArr                'fuer jede Ansicht auf Blatt (inkl. Blatt selber)
            'gezeichnete Linien auf Layer sDelLayer loeschen
            Set swSketch = vView.GetSketch
            vSktSgArr = swSketch.GetSketchSegments
            If IsArray(vSktSgArr) Then
                swModel.ClearSelection2 (True)
                boolstatus = swDrawDoc.ActivateView(vView.Name)
                For Each vSktSg In vSktSgArr    'fuer jedes Skizzenelement
                    If vSktSg.Layer = sDelLayer Then
                        boolstatus = vSktSg.Select4(True, swSelData)
                    End If
                Next 'element
                swModel.EditDelete
            End If
            'Bloecke?
            'Ansichten?
            'Koerperkanten?
        Next 'view
    Next 'sheet
    boolstatus = swDrawDoc.ActivateSheet(activeSheet.GetName)
End Sub


Gruß, Christian

[Diese Nachricht wurde von Christian_W am 27. Jun. 2019 editiert.]

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)2024 CAD.de | Impressum | Datenschutz