Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  SolidWorks
  Auslesen eines Kreismittelpunktes per VBA/API

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
  
AMB
Autor Thema:  Auslesen eines Kreismittelpunktes per VBA/API (1395 mal gelesen)
damagedbrain
Mitglied
Entwickler, Konstrukteur


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

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 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 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)


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: 25. Apr. 2019 10:12    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 damagedbrain 10 Unities + Antwort hilfreich

Hallo,

ich hätte gedacht, der Mittelpunkt lässt sich so nicht mal von Hand übernehmen … geht aber 

vermute die Lösung könnte hier zu finden sein: https://help.solidworks.com/2016/english/api/sldworksapi/Get_All_Elements_of_Sketch_Example_VB.htm

* alle Sketchsegmente durchgehen,
* wenn es typ arc ist, mit getcenterpoint2 den Mittelpunkt holen.
* den irgendwie in die selection nehmen
* dann SketchUseEdge3 probieren.

Gruß, Christian

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

damagedbrain
Mitglied
Entwickler, Konstrukteur


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

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 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 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)


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: 25. Apr. 2019 12: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 Nur für damagedbrain 10 Unities + Antwort hilfreich

Hallo

evtl über SelectionManager und selMgr.AddSelectionListObjects

hab ich aber selber auch nicht auf dem Schirm … 

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

damagedbrain
Mitglied
Entwickler, Konstrukteur


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

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 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,

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



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

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 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 damagedbrain 10 Unities + Antwort hilfreich


SelPoints.wmv

 
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


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

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 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 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 >>)

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