| |
| 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
Beiträge: 124 Registriert: 10.09.2012 SolidWorks 2018 Office 2010 AutoCAD 2007
|
erstellt am: 19. Jun. 2019 08:19 <-- editieren / zitieren --> Unities abgeben:
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...
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 / zitieren --> Unities abgeben: Nur für wemasb
|
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 25. Jun. 2019 14:37 <-- editieren / zitieren --> Unities abgeben: Nur für wemasb
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 sindDu 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
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 25. Jun. 2019 19:33 <-- editieren / zitieren --> Unities abgeben: Nur für wemasb
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 ExplicitSub 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
Beiträge: 124 Registriert: 10.09.2012 SolidWorks 2018 Office 2010 AutoCAD 2007
|
erstellt am: 26. Jun. 2019 07:02 <-- editieren / zitieren --> Unities abgeben:
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)
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 / zitieren --> Unities abgeben: Nur für wemasb
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
Beiträge: 124 Registriert: 10.09.2012 SolidWorks 2018 Office 2010 AutoCAD 2007
|
erstellt am: 26. Jun. 2019 13:28 <-- editieren / zitieren --> Unities abgeben:
|
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 26. Jun. 2019 16:49 <-- editieren / zitieren --> Unities abgeben: Nur für wemasb
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 ExplicitDim 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)
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 / zitieren --> Unities abgeben: Nur für wemasb
|
Christian_W Ehrenmitglied V.I.P. h.c. Konstrukteur (Dipl-Ing)
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 / zitieren --> Unities abgeben: Nur für wemasb
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 ExplicitDim 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
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 26. Jun. 2019 19:54 <-- editieren / zitieren --> Unities abgeben: Nur für wemasb
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
Beiträge: 124 Registriert: 10.09.2012 SolidWorks 2018 Office 2010 AutoCAD 2007
|
erstellt am: 27. Jun. 2019 07:56 <-- editieren / zitieren --> Unities abgeben:
|
Christian_W Ehrenmitglied V.I.P. h.c. Konstrukteur (Dipl-Ing)
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 / zitieren --> Unities abgeben: Nur für wemasb
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 |