| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte | | | | PNY bietet das umfangreichste Ökosystem von B2B als auch B2C-Lösungen für IT-Akteure auf dem Markt, eine Pressemitteilung
|
Autor
|
Thema: Abhängikeiten für O-Ring-Nut setzen (1408 mal gelesen)
|
st.w Mitglied
Beiträge: 59 Registriert: 08.11.2011
|
erstellt am: 26. Mai. 2014 14:21 <-- editieren / zitieren --> Unities abgeben:
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 |
rkauskh Moderator Dipl.-Ing. (FH) Versorgungstechnik
Beiträge: 2580 Registriert: 15.11.2006 Windows 10 x64, AIP 2020-2025
|
erstellt am: 26. Mai. 2014 18:42 <-- editieren / zitieren --> Unities abgeben: Nur für st.w
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 |
st.w Mitglied
Beiträge: 59 Registriert: 08.11.2011
|
erstellt am: 27. Mai. 2014 09:04 <-- editieren / zitieren --> Unities abgeben:
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 |
rkauskh Moderator Dipl.-Ing. (FH) Versorgungstechnik
Beiträge: 2580 Registriert: 15.11.2006 Windows 10 x64, AIP 2020-2025
|
erstellt am: 27. Mai. 2014 22:05 <-- editieren / zitieren --> Unities abgeben: Nur für st.w
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 ExplicitPublic 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 |
st.w Mitglied
Beiträge: 59 Registriert: 08.11.2011
|
erstellt am: 28. Mai. 2014 08:37 <-- editieren / zitieren --> Unities abgeben:
|
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|