---

Hi,

hab jetzt nach einiger Suche die Methode gefunden die ein SketchPoint bietet:

SketchPoint.Merge Method
Method that merges this sketch point with the input sketch point. Any objects dependent on this sketch point will change their dependency to the new sketch point.

Syntax:

Code:

---

Merge(SketchPoint As SketchPoint)

---

SketchPoint Input SketchPoint object.

Hat hierzu schon mal jemand einen Codeschnipsel programmiert der auf dem aktiven Sketch alle Punkte durchläuft und doppelt vorhandene miteinander merged??

Wäre nett wenn mir hier jemand weiterhelfen könnte.

Ciao Crash

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

---

Hallo Crash,

ich glaube, Du hast das falsch verstanden. Du kannst mit 'Merge' einen Punkt (z.B. Kreiszentrum oder Linienanfangs- oder Endpunkt) neu 'zuweisen'. Mach mal folgendes:
Oeffne ein neues Part-Doc, eine Skizze muss aktiv sein. Zeichne ein paar Kreise irgendwo hin auf Deine Skizzeneben. Lass dann diesen code laufen:

Private Sub MergeCenters()
 
  Dim oApp As Application
  Set oApp = ThisApplication
 
  Dim oDoc As PartDocument
  Set oDoc = oApp.ActiveDocument
 
  Dim oSketch As PlanarSketch
  Set oSketch = oDoc.ActivatedObject
 
  Dim oCircles As SketchCircles
  Set oCircles = oSketch.SketchCircles
 
  Dim oCircle As SketchCircle
 
  Dim oTG As TransientGeometry
  Set oTG = oApp.TransientGeometry
 
  Dim oPt2D As Point2d
  Set oPt2D = oTG.CreatePoint2d(0#, 0#)
   
  Dim oPt As SketchPoint
  Set oPt = oSketch.SketchPoints.Add(oPt2D)
 
  For Each oCircle In oCircles
   
    Call oCircle.CenterSketchPoint.Merge(oPt)
   
  Next oCircle
 
End Sub

Nun sind alle Kreise auf 0,0 ausgerichtet. Du kannst damit auch, wenn Du z.B. einen offenes Skizzenprofil hast, die Oeffnung schliessen, indem Du z.B. den Endpunkt der einen Linie auf den Anfangspunkt der zweiten Linie 'mergest' - also zusammenfuehrst.

Ich denke, das ist das, was Du etwa gesucht hast, in Deinem Beitrag '4 Einzellinien zu Rechteck verbinden' ?

Ich hoffe, das hilft.

Gruesse,

Paul

www.morecam.ch/cad.htm

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

---

Ja, das war was ich gesucht habe und zwischenzeitlich auch schon mal testweise was geschrieben.

Irgendwie klappt das bei mir nicht, das ich alle auf der Skizze befindlichen SketchPoints durchlaufe, und bei 2 maligem vorkommen eines Punktes diese 2 merge.

Ich bekomme danach im Inventor 1 einzige Linie zu sehen. SketchPoints sind 4 Stück da, aber nur eine Linie. Wenn ich dann Extrude drücke schmiert der Inventor ab.

Hier mal den Code (den nicht funktionierenden Merge-Teil habe ich rausgeworfen):

Mein extrude-Objekt ruft für jedes gezeichnete Element die w2c_draw Methode auf, diese zeichnet mir die Linien (später auch Kreise, usw.)

Code:

---

For Each Item In m_Geometry
    Call Item.w2c_draw(Sketch)
Next Item

---

Davor werden noch einige Einstellungen gesetzt usw. die mit dem Inventor usw. aber keinen Zusammenhang haben.

Nach meinem Codeschnipsel hier, befinden sich also alle Linien auf meiner Skizze. Jetzt möchte ich die Skizze durchlaufen und alle doppelt vorhhanden Punkte miteinander verbinden, um so dann alle Endpunkte und Anfangspunkte der Linien die gleich sind zu verbinden und ein Profil zu bekommen das ich dann extrudieren kann.

Kannst du mir vielleicht dahingehend deinen Code mal anpassen, vielleicht mache ich ja auch nur irgendwas falsch.

Ciao Crash

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

---

Hallo Crash,

wenn ich Dich richtig verstehe, dann willst Du bei einem (z.B.)Linienhaufen alle Anfangs- und Endpunkte verbinden, dass es ein geschlossenes Profil ergibt ? Ist es das ?
Da hast entweder Du einen Denkfehler oder ich sitz' auf der Leitung...

Wenn ich richtig annehem, dann musst Du (fuer das Bsp. 'Linien' in der Sketch mal alle Linien abgreifen, dann musst Du mal alle Linien, die einen gemeinsamen Punkt aufweisen, rausfiltern (die sind ja schon aneinander). Alle Linien, die keine gemeinsamen Start und/oder Endpunkte haben, musst Du nun 'mergen' - Du musst da wahrscheinlich den naechsten 'freien' Anfangs- oder Endpunkt suchen und zusammenfuehren.

Ist es das, was Du suchst ?

Gruesse,

Paul

www.morecam.ch/cad.htm

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

---

Ich habe folgenden Code nach meinem einfügen der Linien laufen...

Code:

---

For Each LineItem In Sketch.SketchLines
    StartCounter = 0
    EndCounter = 0

    For Each PointItem In Sketch.SketchPoints
        If PointItem.Geometry.x = LineItem.StartSketchPoint.Geometry.x And PointItem.Geometry.y = LineItem.StartSketchPoint.Geometry.y Then
            StartCounter = StartCounter + 1

            If StartCounter = 2 Then
                PointItem.Merge (LineItem)
                StartCounter = 0
            End If
        End If
           
        If PointItem.Geometry.x = LineItem.EndSketchPoint.Geometry.x And PointItem.Geometry.y = LineItem.EndSketchPoint.Geometry.y Then
            EndCounter = EndCounter + 1
               
            If EndCounter = 2 Then
                PointItem.Merge (LineItem)
                EndCounter = 0
            End If
        End If
    Next PointItem
Next LineItem

---

Aber er sagt mir beim Mergen das er diesen Befehl nicht unterstützt?? Was mache ich denn nur falsch???

Ciao Crash

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

---

Hi Crash,

Du hast sicher auch ein Test-Part-file mit irgendwelchen Linien zum zusammenfuehren ? Bitte lade es hoch, dann schu' ich mal rein.

Gruesse,

Paul

www.morecam.ch/cad.htm

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

---

CADForum-4Lines8Points-MergeFunction.zip

Ok,

hier ist die Datei und mein neuer Code dazu. Dieser soll einfach alle Punkte die doppelt vorkommen mergen und mir so ein zusammengehöriges Profil meiner 4 Linien erzeugen.

Code:

---

    Dim StartCounter As Integer
    Dim PointItemMaster As SketchPoint
    Dim PointItemClient As SketchPoint
   
    For Each PointItemMaster In Sketch.SketchPoints
        StartCounter = 0
        For Each PointItemClient In Sketch.SketchPoints
            If PointItemClient.Geometry.x = PointItemMaster.Geometry.x And PointItemClient.Geometry.y = PointItemMaster.Geometry.y Then
                StartCounter = StartCounter + 1
               
                If StartCounter = 2 Then
                    PointItemMaster.Merge (PointItemClient)
                    StartCounter = 0
                    Exit For
                End If
            End If
        Next PointItemClient
    Next PointItemMaster

---

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

---

Hat sich glaub ich vorerst mal erledigt. Fehler war die Klammersetzung bei VB beim Merge-Befehl:

Hier der funktionierende Code um alle Punkte auf Duplikate zu überprüfen und diese zu mergen:

Code:

---

    Dim StartCounter As Integer
    Dim PointItemMaster As SketchPoint
    Dim PointItemClient As SketchPoint
   
    For Each PointItemMaster In Sketch.SketchPoints
        StartCounter = 0
        For Each PointItemClient In Sketch.SketchPoints
            If PointItemClient.Geometry.x = PointItemMaster.Geometry.x And PointItemClient.Geometry.y = PointItemMaster.Geometry.y Then
                StartCounter = StartCounter + 1
               
                If StartCounter = 2 Then
                    PointItemMaster.Merge PointItemClient
                    StartCounter = 0
                    Exit For
                End If
            End If
        Next PointItemClient
    Next PointItemMaster

---

Sketch ist bei mir ein Verweis auf die zur Zeit aktuelle Skizze.

Ciao und Danke
Crash

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

---

Hallo Crash,

here we go:

Private Sub MergeLines()

  Dim oApp As Application
  Set oApp = ThisApplication
 
  Dim oDoc As PartDocument
  Set oDoc = oApp.ActiveDocument
 
  Dim oSketch As PlanarSketch
  Set oSketch = oDoc.ActivatedObject
 
 
  'doppelte Punkte suchen und mergen
  Dim oPoints As SketchPoints
  Set oPoints = oSketch.SketchPoints
 
  ' Merge Test: Punkte vorher
  MsgBox oPoints.Count
 
 
  For i = 1 To oPoints.Count
 
    For j = 1 To oPoints.Count
   
      If j <> i And oPoints(i).Geometry.X = oPoints(j).Geometry.X _
                And oPoints(i).Geometry.Y = oPoints(j).Geometry.Y Then
               
        On Error Resume Next
        Call oPoints(j).Merge(oPoints(i))
       
      End If
   
    Next j
 
  Next i

 
  ' Merge Test: Punkte nachher
  Set oPoints = oSketch.SketchPoints
  MsgBox oPoints.Count

End Sub

Jetzt klappt's auch mit dem Extrudieren...

Uebrigens: so wie's aussieht, erzeugst Du erst 2 Punkte und verbindest diese mit einer Linie usw.
Wenn die Punkte nicht unbedingt noetig sind, geht's auch einfacher...

Gruesse,

Paul

www.morecam.ch/cad.htm

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

---

Doch, leider sind die 2 Punkte schon nötig. Ich lese mir aus einer XML Liniendaten aus, die speichern Start und Endpunkt. Da die Linien nicht wissen das sie ein Profil sind, ist das also schon nötig...

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

---

Und dann solltet Ihr vielleicht noch berücksichtigen, das es Rundungsfehler gibt. Evtl. solltet ihr das Kriterium "=" noch etwas entschärfen.

Gruß Mathias

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

---

Morgen zusammen,

Mathias, Du hast natuerlich voellig recht. in solchen Faellen koennen natuerlich Rundungsfehler auftreten. Zu loesen waere das mit einem geaenderten Vergleich, etwa so, dass anstelle von '=' jeweils den Vergleich auf +- 0.001mm einschraenken, etwa so:

... oPoints(i).Geometry.X > (oPoints(j).Geometry.X - 0.0001) And oPoints(i).Geometry.X < (oPoints(j).Geometry.X + 0.0001) And oPoints(i).Geometry.Y > (oPoints(j).Geometry.Y - 0.0001) And oPoints(i).Geometry.Y < (oPoints(j).Geometry.Y + 0.0001)

Oder ev. mit  Round('Zahl' , 'Nachkommastellen') die X und Y Koordinaten erst in eine Double speichern. Allerdings hat da VB so seine eigenheiten: je nach service pack wird  eine '5' abgerundet oder eben aufgerundet...

Gruesse,

Paul

www.morecam.ch/cad.htm

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

---

Da grausts einem ja, wenn man das sieht :-))))
Ich würde eine Funktion empfehlen, die den Vektor zwischen den beiden Punkten berechnet. Ist dessen Länge kleiner wie ein bestimmtes Epsilon, sind die Punkte gleich. Das ist zwar einmal etwas Arbeit, macht die Sache aber übersichtlicher und flexibler, da man das Epsilon sogar von aussen ändern könnte.

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

---

Hallo Waldi,

natuerlich wahr - viele Wege fuehren nach Rom...

Gruesse,

Paul

www.morecam.ch/cad.htm

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