| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für SOLIDWORKS | | | | AMB |
Autor
|
Thema: Auslesen eines Kreismittelpunktes per VBA/API (1395 mal gelesen)
|
damagedbrain Mitglied Entwickler, Konstrukteur
Beiträge: 37 Registriert: 28.04.2008 Win 10 Pro 64bit SolidWorks 2017 x64 SP 5.0 SolidWorks PDM Enterprise 18.4 (B76) AMD Ryzen 5 3600 6-Core Processor 3.59 GHz 32GB RAM
|
erstellt am: 25. Apr. 2019 07:00 <-- editieren / zitieren --> Unities abgeben:
Guten Morgen liebe VBA/API-Profis, ich möchte aus einer Skizze die Mittelpunkte mehrerer Kreise auslesen, oder genauer gesagt ich möchte diese Mittelpunkte mittels dem Befehl »Elemente übernehmen« in eine andere Skizze übernehmen, kam bisher aber leider nicht auf den entsprechenden Befehl. Wie ich die zugehörigen Kreise übernhemen kann, weiß ich, aber eben leider nicht die Mittelpunkte dazu. Die Makroaufzeichnung ergab folgendes Ergebnis: Sub main() Set swApp = Application.SldWorks Set Part = swApp.ActiveDoc boolstatus = Part.Extension.SelectByID2("Point2435@Skizze2", "EXTSKETCHPOINT", 4.99999999999994E-03, 4.10000000000087E-02, 0, False, 0, Nothing, 0) boolstatus = Part.SketchManager.SketchUseEdge3(False, False) Part.ClearSelection2 True End Sub Ich bräuchte entweder den direkten Befehl um die Punkte zu übernehmen (mit Verknüpfung, damit diese bei einer Maßänderung mitziehen), oder durch den Umweg irgendwie den Punktnamen ("Point2435@Skizze2") auszulesen. Ich hoffe jemand kann mir helfen. Viele Grüße Ronny 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: 25. Apr. 2019 10:12 <-- editieren / zitieren --> Unities abgeben: Nur für damagedbrain
|
damagedbrain Mitglied Entwickler, Konstrukteur
Beiträge: 37 Registriert: 28.04.2008 Win 10 Pro 64bit SolidWorks 2017 x64 SP 5.0 SolidWorks PDM Enterprise 18.4 (B76) AMD Ryzen 5 3600 6-Core Processor 3.59 GHz 32GB RAM
|
erstellt am: 25. Apr. 2019 11:20 <-- editieren / zitieren --> Unities abgeben:
Hallo Christian, danke für die Antwort. Hier liegt ja der Hund begraben: ich bekomm es hin die Koordinaten des Punktes auszulesen, aber leider bekomme ich es nicht hin den Punkt zu selektieren oder dessen interne Bezeichnung auszulesen um diesen mit dem im aufgezeichneten Macro enthaltenen Befehl zu selektieren. Ist es denn möglich den Punkt irgendwie mit den Infos aus dem Beispiel-Macro zu selektieren? Gruß Ronny 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: 25. Apr. 2019 12:19 <-- editieren / zitieren --> Unities abgeben: Nur für damagedbrain
|
damagedbrain Mitglied Entwickler, Konstrukteur
Beiträge: 37 Registriert: 28.04.2008 Win 10 Pro 64bit SolidWorks 2017 x64 SP 5.0 SolidWorks PDM Enterprise 18.4 (B76) AMD Ryzen 5 3600 6-Core Processor 3.59 GHz 32GB RAM
|
erstellt am: 29. Apr. 2019 07:19 <-- editieren / zitieren --> Unities abgeben:
Guten Morgen, könnte zwar sein, dass es irgendwie funktionieren würde. Da ich aber kein Profi im Programmieren sondern lediglich Hobby-Bastler bin, bekomme ich es leider nicht hin. Werde wohl kapitulieren müssen. Trotzdem danke! Grüße Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
nahe Ehrenmitglied
Beiträge: 1747 Registriert: 18.01.2001 arbeite mit: Dell Precision 7750 i7 2,6 GHz 6 Kerne 32GB RAM 512GB SSD NVIDIA Quadro RTX 4000 ------------------------ SWX-2020 SP5.0 EPDM ---------------- Windows 10 ---------------- VB.net VB VBA ein wenig Swift am Mac
|
erstellt am: 07. Mai. 2019 06:29 <-- editieren / zitieren --> Unities abgeben: Nur für damagedbrain
Hallo Ronny, anbei mal was zum probieren Achtung: das Makro geht davon aus, dass eine Skizze UND eine Ebene angewählt ist, bevor es gestartet wird Die Reihenfolge ist auch wichtig (siehe Video im Anhang) Option Explicit
Type xyp x As Double y As Double End Type Sub main() Dim swApp As Object Dim sketch As sketch Dim feat As Feature Dim selmgr As SelectionMgr Dim obj As Object Dim spl As Variant 'Liste Skizzenpunkte Dim acl As Variant 'Liste der Skizzen-Bögen Dim sp As SketchPoint Dim spsl() As SketchPoint 'Liste der Skizzen-Mittel-Punkte Dim pl() As xyp 'Liste der Mittelpunkt aus der Liste der Skizzen-Bögen Dim p As xyp Dim swSketchMgr As SketchManager Dim Part As ModelDoc2 Dim z As Integer, i As Integer, j As Integer 'Zähler und Schleifenvariablen Set swApp = Application.SldWorks Set Part = swApp.ActiveDoc Set selmgr = Part.SelectionManager 'Erstes gewähltes Objekt muss die Skizze sein Set obj = selmgr.GetSelectedObject6(1, 0) 'Wurde was gewählt? If Not obj Is Nothing Then 'Handelt es sich um eine Skizze? If obj.GetType = swSelectType_e.swSelSKETCHES Then 'Feature holen Set feat = selmgr.GetSelectedObject6(1, 0) 'Skizze holen Set sketch = feat.GetSpecificFeature2 'Skizzenpunkte holen spl = sketch.GetSketchPoints2 'Bögen holen acl = sketch.GetArcs2 'Feld für Mittelpunkte initialisieren ReDim pl(sketch.GetArcCount - 1) z = 0 'Mittelpunkte holen For i = 0 To sketch.GetArcCount - 1 p.x = acl(16 * i + 12) p.y = acl(16 * i + 13) pl(i) = p Next i 'Alle Skizzenpunkt durchlaufen For i = 0 To UBound(spl) Set sp = spl(i) p.x = sp.x p.y = sp.y 'Alle Mittelpunkte durchlaufen For j = 0 To UBound(pl) 'Wenn der Skizzenpunkt ein Mittelpunkt ist If pl(j).x = p.x And pl(j).y = p.y Then 'Skizzen-Mittel-Punkt Liste initilisieren If z = 0 Then ReDim spsl(z) Else ReDim Preserve spsl(z) End If 'Skizze-Mmittel-Punkt setzen Set spsl(z) = sp z = z + 1 End If Next j Next i 'Zweites Element muss die Ebene sein auf die die Punkt projiziert werden Set obj = selmgr.GetSelectedObject6(2, 0) 'wurde ein Element gewählt? If Not obj Is Nothing Then 'handelt es sich um eine Ebene If obj.GetType = swSelectType_e.swSelDATUMPLANES Then 'Feature holen Set feat = selmgr.GetSelectedObject6(2, 0) 'Ebene holen 'Set ebene = feat.GetSpecificFeature2 'auswahl zurücksetzen Part.ClearSelection2 True 'Ebene wählne Part.Extension.SelectByID2 feat.Name, "PLANE", 0, 0, 0, False, 0, Nothing, 0 'Skizze einfügen Part.SketchManager.InsertSketch True 'Alle Skizzen-Mittel-Punkte durchlaufen und auswählen For i = 0 To UBound(spsl) If i = 0 Then spsl(i).Select (False) Else spsl(i).Select (True) Next i 'Punkte übernehmen Part.SketchManager.SketchUseEdge3 False, False 'Skizze schließen Part.SketchManager.InsertSketch True Part.ClearSelection2 True End If End If End If End If End Sub ------------------ Grüße Heinz Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
damagedbrain Mitglied Entwickler, Konstrukteur
Beiträge: 37 Registriert: 28.04.2008 Win 10 Pro 64bit SolidWorks 2017 x64 SP 5.0 SolidWorks PDM Enterprise 18.4 (B76) AMD Ryzen 5 3600 6-Core Processor 3.59 GHz 32GB RAM
|
erstellt am: 09. Mai. 2019 13:29 <-- editieren / zitieren --> Unities abgeben:
Hallo Heinz, vielen Dank für Dein Makro, welches mich auf die Lösung brachte! Das feine, aber entscheidende ».Select (True)« hat mir gefehlt. Ich habe es immer ohne »(True)« versucht, dabei aber immer eine Fehlermeldung erhalten. Jetzt funktioniert mein Makro genau so, wie es soll! Vielen Dank nochmal!!! Grüße Ronny Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|