---

NichtKoincident.jpg

Hallo vba-ler,

leider komme ich mit der Hilfe, mit Google und Forum nicht weiter, obwohl es so einfach scheint 

Ich möchte eine O-Ring-Nut um eine Bohrung erstellen und da wir das häufig machen möchte ich dies gerne als Makro erstellen.

Alles klappt soweit, bis eben... die Bohrung verschoben wird und
die extrudierte Nutwand nicht mitwandert (da keine Abhängikeiten gesetzt sind.

Weder für den Mittelpunkt des Kreises, noch für den Radius.
Folglich ist meine Frage: Wie muß der Code ergänzt werden, damit diese beiden Abhängigkeiten gesetzt sind.

Danke Für Eure Hilfe,
Stefan

PS: Lauffähiger Code:

Code:

---

Public Sub BohrungMitORingNut()
    Dim oPartDoc As PartDocument
    Set oPartDoc = ThisApplication.Documents.Add(kPartDocumentObject, _
                ThisApplication.FileManager.GetTemplateFile(kPartDocumentObject))    ' Create a new part document, using the default part template.

    Dim oCompDef As PartComponentDefinition
    Set oCompDef = oPartDoc.ComponentDefinition    ' Set a reference to the component definition.

    Dim oSketch As PlanarSketch
    Set oSketch = oCompDef.Sketches.Add(oCompDef.WorkPlanes.Item(3))    ' Create a new sketch on the X-Y work plane.

   
    Dim oTransGeom As TransientGeometry
    Set oTransGeom = ThisApplication.TransientGeometry    ' Set a reference to the transient geometry object.

    ' Create a rectangle on the sketch.
    Call oSketch.SketchLines.AddAsTwoPointRectangle( _
                                        oTransGeom.CreatePoint2d(0, 0), _
                                        oTransGeom.CreatePoint2d(6, 4))
    Dim oProfile As Profile
    Set oProfile = oSketch.Profiles.AddForSolid ' Create the profile.

    Call oCompDef.Features.ExtrudeFeatures.AddByDistanceExtent(oProfile, "30 mm", kNegativeExtentDirection, kJoinOperation)    ' Create an extrusion.
   
    Set oSketch = oCompDef.Sketches.Add(oCompDef.WorkPlanes.Item(3)) ' Create a new sketch to contain the points that define the hole centers.
    oSketch.Edit

    Dim oHoleCenters As ObjectCollection
    Set oHoleCenters = ThisApplication.TransientObjects.CreateObjectCollection ' Create an object collection for the hole center points.
   
    oHoleCenters.Add oSketch.SketchPoints.Add(oTransGeom.CreatePoint2d(1.5, 2))
    oHoleCenters.Add oSketch.SketchPoints.Add(oTransGeom.CreatePoint2d(4.5, 2)) ' Add two points as hole centers.
   
    Call oCompDef.Features.HoleFeatures.AddDrilledByDistanceExtent(oHoleCenters, "20 mm", "1 mm", kPositiveExtentDirection)                            ' Create the hole feature.
    Dim oSketchPoint As SketchPoint
    Dim oSketchCircle As SketchCircle
    Dim oExtrudeFeature As ExtrudeFeature
    For Each oSketchPoint In oSketch.SketchPoints
        If oSketchPoint.HoleCenter Then ' wenn Bohrpunkt, dann merken
            Set oSketchCircle = oSketch.SketchCircles.AddByCenterRadius(oSketchPoint, 0.5 * 1.7) ' Create a circle on the sketch.
            Set oProfile = oSketch.Profiles.AddForSolid ' Create the profile.
            Set oExtrudeFeature = oCompDef.Features.ExtrudeFeatures.AddByDistanceExtent(oProfile, "1 mm", kNegativeExtentDirection, kJoinOperation)                          ' Create an extrusion.
           
        Call oCompDef.Features.HoleFeatures.AddDrilledByDistanceExtent( _
                                oHoleCenters, "15 mm", "50 mm", kPositiveExtentDirection, False, "118 grd")
        End If
    Next
    oSketch.ExitEdit
    oSketch.Visible = True
End Sub

---

------------------
IV2008

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

---

Hallo

Was du suchst sind die GeometricConstraints.AddCoincident und .AddEqualRadius Methoden.

GeometricConstraints.AddCoincident( EntityOne As SketchEntity, EntityTwo As SketchEntity ) As CoincidentConstraint
GeometricConstraints.AddEqualRadius( EntityOne As SketchEntity, EntityTwo As SketchEntity ) As EqualRadiusConstraint

------------------
MfG
Ralf

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

---

Hallo Ralf,

ich habe Deine Vorschläge angewandt, z.B. für AddCoincident:

Code:

---

            Set oSketchCircle = oSketch.SketchCircles.AddByCenterRadius(oSketchPoint, 0.5 * 1.7)

                            Dim oCenterPoint As SketchPoint
                            Set oCenterPoint = oSketch.SketchPoints.Add(oSketchCircle.Geometry.Center, False)
                            Call oSketch.GeometricConstraints.AddCoincident(oSketchPoint, oCenterPoint)
            Dim oTextPoint As Point2d
            Set oTextPoint = oTransGeom.CreatePoint2d(oCenterPoint.Geometry.x, oCenterPoint.Geometry.y)
            Call oSketch.DimensionConstraints.AddRadius(oSketchCircle, oTextPoint)

---

doch dies scheint keinen Effekt zu haben.

Ich kann weiterhin (wie im Bild des ersten Posts zu sehen, den Mittel-Bohrpunkt verschieben und nach dem Aktualisieren ist die Bohrung gefolgt, die Extrusion jedoch bleibt zurück. Was muß ich da noch ändern?

Danke weiterhin,
Stefan

PS: Bei dem von Dir vorgeschlagenen AddEqualRadius hätte ich Entities gebraucht, aber ich habe über diese Recherche die AddRadius-Funktion gefunden und die klappt.

------------------
IV2008

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

---

Hallo

Aber ich war nah dran mit den Abhängigkeitsnamen. 

Du erstellst da noch einen zusätzlichen Skizzenpunkt, den es a) nicht braucht und den du b) für die Abhängigkeit benutzt. Du verbindest zwei Skizzenpunkte mit Koinzident, läßt aber den Kreismittelpunkt außen vor. Deswegen passiert scheinbar nichts. Ich hab deinen Code mal angepaßt und für die Optik die Bemaßung aus dem Zentrum geschubst.

Code:

---

Option Explicit

Public Sub BohrungMitORingNut()
    Dim oPartDoc As PartDocument
    Set oPartDoc = ThisApplication.Documents.Add(kPartDocumentObject, _
                ThisApplication.FileManager.GetTemplateFile(kPartDocumentObject))    ' Create a new part document, using the default part template.

    Dim oCompDef As PartComponentDefinition
    Set oCompDef = oPartDoc.ComponentDefinition    ' Set a reference to the component definition.

    Dim oSketch As PlanarSketch
    Set oSketch = oCompDef.Sketches.Add(oCompDef.WorkPlanes.Item(3))    ' Create a new sketch on the X-Y work plane.

 
    Dim oTransGeom As TransientGeometry
    Set oTransGeom = ThisApplication.TransientGeometry    ' Set a reference to the transient geometry object.

    ' Create a rectangle on the sketch.
    Call oSketch.SketchLines.AddAsTwoPointRectangle( _
                                        oTransGeom.CreatePoint2d(0, 0), _
                                        oTransGeom.CreatePoint2d(6, 4))
    Dim oProfile As Profile
    Set oProfile = oSketch.Profiles.AddForSolid ' Create the profile.

    Call oCompDef.Features.ExtrudeFeatures.AddByDistanceExtent(oProfile, "30 mm", kNegativeExtentDirection, kJoinOperation)    ' Create an extrusion.
 
    Set oSketch = oCompDef.Sketches.Add(oCompDef.WorkPlanes.Item(3)) ' Create a new sketch to contain the points that define the hole centers.
    oSketch.Edit

    Dim oHoleCenters As ObjectCollection
    Set oHoleCenters = ThisApplication.TransientObjects.CreateObjectCollection ' Create an object collection for the hole center points.
 
    oHoleCenters.Add oSketch.SketchPoints.Add(oTransGeom.CreatePoint2d(1.5, 2))
    oHoleCenters.Add oSketch.SketchPoints.Add(oTransGeom.CreatePoint2d(4.5, 2)) ' Add two points as hole centers.
 
    Call oCompDef.Features.HoleFeatures.AddDrilledByDistanceExtent(oHoleCenters, "20 mm", "1 mm", kPositiveExtentDirection)                            ' Create the hole feature.
    Dim oSketchPoint As SketchPoint
    Dim oSketchCircle As SketchCircle
    Dim oExtrudeFeature As ExtrudeFeature
    For Each oSketchPoint In oSketch.SketchPoints
        If oSketchPoint.HoleCenter Then ' wenn Bohrpunkt, dann merken
            Set oSketchCircle = oSketch.SketchCircles.AddByCenterRadius(oSketchPoint, 0.5 * 1.7) ' Create a circle on the sketch.
            Call oSketch.GeometricConstraints.AddCoincident(oSketchPoint, oSketchCircle.CenterSketchPoint)
            Dim oTextPoint As Point2d
            Set oTextPoint = oTransGeom.CreatePoint2d(oSketchPoint.Geometry.x + 1, oSketchPoint.Geometry.Y + 1)
            Call oSketch.DimensionConstraints.AddRadius(oSketchCircle, oTextPoint)
            Set oProfile = oSketch.Profiles.AddForSolid ' Create the profile.
            Set oExtrudeFeature = oCompDef.Features.ExtrudeFeatures.AddByDistanceExtent(oProfile, "1 mm", kNegativeExtentDirection, kJoinOperation)                          ' Create an extrusion.
         
        Call oCompDef.Features.HoleFeatures.AddDrilledByDistanceExtent( _
                                oHoleCenters, "15 mm", "50 mm", kPositiveExtentDirection, False, "118 grd")
        End If
    Next
    oSketch.ExitEdit
    oSketch.Visible = True
End Sub

---

------------------
MfG
Ralf

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

---

Danke Ralf, es funktioniert wunderbar.

"Die Wahrheit ist einfach", sagte schon Sokrates, wie wahr, wie wahr.

Nochmals Danke, und einen schönen Tag,
Stefan

------------------
IV2008

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