| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für SOLIDWORKS |
| |
| PLM TechnologieForum Hannover |
Autor
|
Thema: Indizes mit Kreis aussenrum /Textsymbol) per Macro löschen (1949 mal gelesen)
|
oma1 Mitglied designer
Beiträge: 131 Registriert: 22.03.2005 SW 2007 SP 3.4<P>Windows XP SP2<P>DELL Precision M65 Intel Core 2 2Ghz 2GB RAM
|
erstellt am: 21. Jun. 2007 07:42 <-- editieren / zitieren --> Unities abgeben:
Ist es eigentlich möglich in einer Zeichnung per Macro nach Indizes (p1, p2, p3, ...)mit Kreis aussenrum, die mit Textsymbol erstllet wurden zu suchen und alle per Macro zu löschen? Irgendwie mit GET.Notes oder so in verbidung mit Not.Setballon oder so ????? Hab da schon einiges probiert, kann aber nur indizes setzten, aber nicht löschen oder finden :-( ------------------ cma Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Lutz Federbusch Ehrenmitglied V.I.P. h.c. Dipl.-Ing. Maschinenbau
Beiträge: 3094 Registriert: 03.12.2001 alle SW seit 97+ AutoCAD2016-2022 ERP ProAlpha + CA-Link Intel Core i7-7820K 32GB Win10x64 Quadro K5000 SpacePilot
|
erstellt am: 21. Jun. 2007 15:18 <-- editieren / zitieren --> Unities abgeben: Nur für oma1
|
oma1 Mitglied designer
Beiträge: 131 Registriert: 22.03.2005 SW 2007 SP 3.4<P>Windows XP SP2<P>DELL Precision M65 Intel Core 2 2Ghz 2GB RAM
|
erstellt am: 21. Jun. 2007 16:42 <-- editieren / zitieren --> Unities abgeben:
Die Indizes die man in der Datei nebenstehend sehen kann, will ich per Macro löschen. Sind erstellbar durch den vbabefehl: Set Note = Part.InsertNote("p1") If Not Note Is Nothing Then Note.Angle = 0 boolstatus = Note.SetBalloon(1, 0) Set Annotation = Note.GetAnnotation() If Not Annotation Is Nothing Then longstatus = Annotation.SetLeader2(False, 0, True, False, False, False) boolstatus = Annotation.SetPosition(0.07588489386792, 0.2613880188679, 0) boolstatus = Annotation.SetTextFormat(0, True, TextFormat) End If End If Is jetzt alles ein wenig klarer?
Die Indizes sind halt nicht per vab erstellt sondern durch Text einfügen irgendwo auf dem Blatt verteilt und können von p1 bis pxx hochlaufen. Und genau diese sollten per vba gefunden werden und gelöscht werden ------------------ cma Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
u.clemens Mitglied Konstrukteur
Beiträge: 964 Registriert: 04.07.2000 engineer's law o cheap o fast o good check only two !
|
erstellt am: 21. Jun. 2007 17:09 <-- editieren / zitieren --> Unities abgeben: Nur für oma1
wo ist das Problem du gibts mit Setballon( 1,) dem Bezugshinweis einen entsprechenden Style. Wenn du die wiederfinden willst, muß du über alle Blätter, alle Ansichten alle Bezugshinweise abklappern, dir den Style mit GetBalloonStyle holen, vergleichen und ggfs. den Bezugshinweis löschen. ------------------ mfg uc Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
oma1 Mitglied designer
Beiträge: 131 Registriert: 22.03.2005 SW 2007 SP 3.4<P>Windows XP SP2<P>DELL Precision M65 Intel Core 2 2Ghz 2GB RAM
|
erstellt am: 22. Jun. 2007 10:04 <-- editieren / zitieren --> Unities abgeben:
|
Lutz Federbusch Ehrenmitglied V.I.P. h.c. Dipl.-Ing. Maschinenbau
Beiträge: 3094 Registriert: 03.12.2001 alle SW seit 97+ AutoCAD2016-2022 ERP ProAlpha + CA-Link Intel Core i7-7820K 32GB Win10x64 Quadro K5000 SpacePilot
|
erstellt am: 22. Jun. 2007 10:22 <-- editieren / zitieren --> Unities abgeben: Nur für oma1
Mal so als Idee: Wenn Du die Note nicht löschen kannst (auswählen müßte doch gehen, dafür gibts Beispiele in der API-Hilfe), dann könntest Du sie aber auf unsichtbar schalten (note.visible) oder den Text überschreiben oder alles auf einen ausgeblendeten Layer schieben... ------------------ Lutz Federbusch Mein Gästebuch Der Mensch, Herr oder Sklave der Technik? Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
oma1 Mitglied designer
Beiträge: 131 Registriert: 22.03.2005 SW 2007 SP 3.4<P>Windows XP SP2<P>DELL Precision M65 Intel Core 2 2Ghz 2GB RAM
|
erstellt am: 28. Jun. 2007 11:10 <-- editieren / zitieren --> Unities abgeben:
|
oma1 Mitglied designer
Beiträge: 131 Registriert: 22.03.2005 SW 2007 SP 3.4<P>Windows XP SP2<P>DELL Precision M65 Intel Core 2 2Ghz 2GB RAM
|
erstellt am: 03. Jul. 2007 08:59 <-- editieren / zitieren --> Unities abgeben:
Jetzt haut es hin, nur so zur Info. Nur kann es bei mir vorkommen, dass nicht alle Indizies gelöscht werden. Lässt man das Programm aber 2-3x laufen, dann wrden alle gelöscht. auch wenn 30 Stück auf em Blatt un den verschiedenen Zeichansichten vorhanden sind! Woran kann das liegen? Hier der code: Sub prototypenindizes_löschen() Dim swApp As Object Dim swDraw As Object Dim swView As Object Dim boolstatus As Boolean Dim text As String Dim ball As Long Dim note As SldWorks.note Dim viewname As String Set swApp = Application.SldWorks Set swDraw = swApp.ActiveDoc swDraw.EditSheet Set swView = swDraw.GetFirstView Do While Not swView Is Nothing Set note = swView.GetFirstNote Do While Not note Is Nothing ball = note.GetBalloonStyle text = note.GetText If ball = "1" Then For i = 0 To 50 If text = "p" & i Then Name = note.GetName text = note.GetText Set Annotation = note.GetAnnotation boolstatus = Annotation.Select2(0, 1) swDraw.EditDelete End If Next i For i = 0 To 50 If text = "P" & i Then Name = note.GetName text = note.GetText Set Annotation = note.GetAnnotation boolstatus = Annotation.Select2(0, 1) swDraw.EditDelete End If Next i End If Set note = note.GetNext Loop Set note = swView.GetFirstNote Set swView = swView.GetNextView Loop End Sub Code ist im Anhang. Kann mir wer sagen, was ich falsch mache?
Danke Christoph ------------------ cma Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Conrad Mitglied Dipl.-Ing. (FH)
Beiträge: 280 Registriert: 20.12.2002 Windows 10 SolidWorks 2018/Sp5.0 Intel(R) XEON(R) CPU E5-1620v4 @ 3.49Ghz 32 GB RAM 64-Bit proALPHA Client for Open Enterprise Server 2 SP4 (IR10) Linux basierte file server
|
erstellt am: 06. Dez. 2007 14:53 <-- editieren / zitieren --> Unities abgeben: Nur für oma1
Hallo! Ich hab ein ähnliches Problem. Es sollen Bezugshinweise - Änderungsindizes gelöscht werden. Sie haben bei uns die Form $PRP:"Index-d" , wobei die Buchstaben von a biz z gehen. Ich hab schon probiert das Makro abzuändern, aber bei den Anführungszeichen hab ich ein Problem. Vieleicht könnt Ihr mir ja helfen ------------------ Grüße aus dem Allgäu Conrad [Diese Nachricht wurde von Conrad am 06. Dez. 2007 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
HartmutT Mitglied Dipl.-Ing (TU) MB
Beiträge: 790 Registriert: 16.06.2006 SWX 2019 SP5.0 MaxxDB 2021.SP0.02 Linked Jan 18 2021 (64bit)
|
erstellt am: 06. Dez. 2007 15:10 <-- editieren / zitieren --> Unities abgeben: Nur für oma1
Hi OmaEINS! Ich bin auch begeisterter Makronutzer und habe manche meiner Kollegen nicht verstanden, daß sie bestimmte Sachen macro-los abarbeiteten. Mittlerweile habe ich aber etwas Nachsicht. Nicht alles muß per Makro gelöst werden. Dein Löschproblem geht mit Klick-Filter-Ballons und großes Fenster drum und Entf-Taste genauso komfortabel. Nurn Vorschlag von mir... Grüßle H. ------------------ Hartmut Tylla http://www.schiwa.de/ Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
u.clemens Mitglied Konstrukteur
Beiträge: 964 Registriert: 04.07.2000 engineer's law o cheap o fast o good check only two !
|
erstellt am: 06. Dez. 2007 15:48 <-- editieren / zitieren --> Unities abgeben: Nur für oma1
@Conrad: probiers mal mit text="$PRP:"&"""Index-d""" ... @HartmutT: und was machst du, wenn auf der Zeichnung noch weitere Bezugshinweise sind, die nicht gelöscht werden sollen - eben nur die eingekreisten Texte. BTW: ich würde mir ja gleich angewöhnen, derartige Kennzeichnungen auf extra Layer zu legen, dann könnte man das viel einfacher per Makro "Lösche alles auf dem Layer" erledigen ... ------------------ mfg uc Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Conrad Mitglied Dipl.-Ing. (FH)
Beiträge: 280 Registriert: 20.12.2002 Windows 10 SolidWorks 2018/Sp5.0 Intel(R) XEON(R) CPU E5-1620v4 @ 3.49Ghz 32 GB RAM 64-Bit proALPHA Client for Open Enterprise Server 2 SP4 (IR10) Linux basierte file server
|
erstellt am: 06. Dez. 2007 16:18 <-- editieren / zitieren --> Unities abgeben: Nur für oma1
Hallo uc! das maco läuft jatzt zwar ohne Probleme durch, nur es löscht nichts Hier mal der code: Sub aenderungsindizes_löschen() Dim swApp As Object Dim swDraw As Object Dim swView As Object Dim boolstatus As Boolean Dim text As String Dim ball As Long Dim note As SldWorks.note Dim viewname As String Set swApp = Application.SldWorks Set swDraw = swApp.ActiveDoc swDraw.EditSheet Set swView = swDraw.GetFirstView Do While Not swView Is Nothing Set note = swView.GetFirstNote Do While Not note Is Nothing ball = note.GetBalloonStyle text = note.GetText If ball = "1" Then For i = a To z If text = "$PRP:" & """Index-""" & i Then Name = note.GetName text = note.GetText Set Annotation = note.GetAnnotation boolstatus = Annotation.Select2(0, 1) swDraw.EditDelete End If Next i For i = a To z If text = "$PRP:" & """Index-""" & i Then Name = note.GetName text = note.GetText Set Annotation = note.GetAnnotation boolstatus = Annotation.Select2(0, 1) swDraw.EditDelete End If Next i End If Set note = note.GetNext Loop Set note = swView.GetFirstNote Set swView = swView.GetNextView Loop End Sub Ich rate mal, daß ich keinen "Durchlauf von a - z machen kann Nicht Lachen , ich bin im Makros schreiben noch ein blutiger Anfänger! ------------------ Grüße aus dem Allgäu Conrad
[Diese Nachricht wurde von Conrad am 06. Dez. 2007 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
u.clemens Mitglied Konstrukteur
Beiträge: 964 Registriert: 04.07.2000 engineer's law o cheap o fast o good check only two !
|
erstellt am: 06. Dez. 2007 17:06 <-- editieren / zitieren --> Unities abgeben: Nur für oma1
|
Conrad Mitglied Dipl.-Ing. (FH)
Beiträge: 280 Registriert: 20.12.2002 Windows 10 SolidWorks 2018/Sp5.0 Intel(R) XEON(R) CPU E5-1620v4 @ 3.49Ghz 32 GB RAM 64-Bit proALPHA Client for Open Enterprise Server 2 SP4 (IR10) Linux basierte file server
|
erstellt am: 07. Dez. 2007 07:46 <-- editieren / zitieren --> Unities abgeben: Nur für oma1
|
u.clemens Mitglied Konstrukteur
Beiträge: 964 Registriert: 04.07.2000 engineer's law o cheap o fast o good check only two !
|
erstellt am: 07. Dez. 2007 09:37 <-- editieren / zitieren --> Unities abgeben: Nur für oma1
hast du denn mal debuggt ? Hat den die Variable text nach text=note.getText den Wert, den du erwartest? Werden denn die If...Then -Bedingungen überhaupt erreicht? Ich glaube nämlich nicht! Weil GetBalloonStyle liefert keine Zeichenkette sondern eine Zahl vom Typ long - somit müßte es wohl heißen If ball=1 then ... (ohne Anführungszeichen). Außerdem weiß ich nicht wozu 2x die for i=... to ...-Schleifen gut sein sollen - die machen doch genau dasselbe ... ... und wozu brauchst du Name = note.GetName und text = note.GetText in der Schleife ? Fragen über Fragen ...
------------------ mfg uc Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Conrad Mitglied Dipl.-Ing. (FH)
Beiträge: 280 Registriert: 20.12.2002 Windows 10 SolidWorks 2018/Sp5.0 Intel(R) XEON(R) CPU E5-1620v4 @ 3.49Ghz 32 GB RAM 64-Bit proALPHA Client for Open Enterprise Server 2 SP4 (IR10) Linux basierte file server
|
erstellt am: 07. Dez. 2007 10:22 <-- editieren / zitieren --> Unities abgeben: Nur für oma1
..ich bekomme als Wert Großbuchstaben! Das Makro hab ich so übernommen, hab mal die Zeilen rausgelöscht. So langsam glaube ich, ich muß mich erst mal etwas tiefer in VisulBasic einarbeiten. Aber trotdem Vielen DAnk für die Hilfe Werd mich in Zukunft dann wohl wieder mal melden ------------------ Grüße aus dem Allgäu Conrad [Diese Nachricht wurde von Conrad am 07. Dez. 2007 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
u.clemens Mitglied Konstrukteur
Beiträge: 964 Registriert: 04.07.2000 engineer's law o cheap o fast o good check only two !
|
erstellt am: 07. Dez. 2007 11:45 <-- editieren / zitieren --> Unities abgeben: Nur für oma1
Zitat: Original erstellt von Conrad: ..ich bekomme als Wert Großbuchstaben!
auf deinem Bild oben sind aber Kleinbuchstaben dargestellt! hab mir das Problem jetzt nochmal genau angesehen und getestet! da ist noch einiges im Argen! note.GetText liefert gar nicht die Bezeichnung des Links zur Dateieigenschaft zurück (wie ich auch irrtümlich annahm), sondern direkt den Wert der Dateieigenschaft. Somit mußt du auch diese Werte abchecken! Das dies bei dir allerdings nicht Kleinbuchstaben - wie auf deinem Bild zu sehen - sind, sondern Großbuchstaben - wer kann das ahnen ... ? Dann war noch das Problem bei oma1, daß nicht alle Einträge in einem Durchlauf gelöscht werde - ist auch logisch! Ist einer der gesuchten Einträge gefunden, wird er sofort gelöscht - damit ist das note-object weg, nachfolgendes getnext geht ins Leere und du fliegst aus der Schleife - es wird je Makrodurchlauf also je Ansicht nur ein - der erste - gesuchter Eintrag gelöscht. Und nicht zuletzt ist die Lösung mit der for...next-Schleife unpassend - viel besser ist hier die Verwendung der case-Anweisung. auf das wesentliche reduziert könnte das Makro also so aussehen:
Code:
Dim swApp As Object Dim swDraw As Object Dim swView As Object Dim boolstatus As Boolean Dim text As String Dim ball As Long Dim swNote As Object Dim viewname As String Sub main() Set swApp = Application.SldWorks Set swDraw = swApp.ActiveDoc swDraw.EditSheet Set swView = swDraw.GetFirstView Do While Not swView Is Nothing Set swNote = swView.GetFirstNote Do While Not swNote Is Nothing ball = swNote.GetBalloonStyle text = swNote.GetText If ball = 1 Then Select Case text Case "A" To "Z", "a" To "z" Set Annotation = swNote.GetAnnotation boolstatus = Annotation.Select2(True, 1) End Select End If Set swNote = swNote.GetNext Loop swDraw.EditDelete Set swView = swView.GetNextView Loop End Sub
hab's getestet, bie mir funktionierts einwandfrei... du kannst es ja dazu nutzen, dir Schritt für Schritt (Debuggen) klar zu machen, was da eigentlich abläuft - nur so wirst du es selbst lernen!------------------ mfg uc Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Conrad Mitglied Dipl.-Ing. (FH)
Beiträge: 280 Registriert: 20.12.2002 Windows 10 SolidWorks 2018/Sp5.0 Intel(R) XEON(R) CPU E5-1620v4 @ 3.49Ghz 32 GB RAM 64-Bit proALPHA Client for Open Enterprise Server 2 SP4 (IR10) Linux basierte file server
|
erstellt am: 07. Dez. 2007 12:46 <-- editieren / zitieren --> Unities abgeben: Nur für oma1
Vielen Dank uc! ..auch bei mitr funktioniert's jetzt Werde heut nachmittag mal den Code Schritt für Schritt durchgehen, um ihn (hoffenltlich ) zu verstehen. ------------------ Grüße aus dem Allgäu Conrad
[Diese Nachricht wurde von Conrad am 07. Dez. 2007 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |