| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
| |
| PNY präsentiert die neue NVIDIA RTX A400 und die A1000 Grafikkarte, eine Pressemitteilung
|
Autor
|
Thema: HoleCenterPoints im HoleFeature (2084 / mal gelesen)
|
3DCS Mitglied Konstrukteur, Programmierer
Beiträge: 10 Registriert: 13.06.2015 Inventor,AutoCad,TurboCad,MS Access,mySQL
|
erstellt am: 26. Apr. 2016 09:46 <-- editieren / zitieren --> Unities abgeben:
Hallo, ich beisse mir schon seit einigen Tagen an einem Problem die Zähne aus und hoffe das hier jemand eine Idee hat. Problem: In einem Bauteil wurden Bohrungen erzeugt (Hole Feature). Basis dieser Bohrungen ist eine Skizze mit einer Anordnung. Da diese Skizze parametrisch gesteuert wird (Anzahl der Bohrungen ändert sich) gehen Bohrungen verloren wenn die Bohrungsanzahl zunächst verringert wurde und dannach wieder erhöht. Die Skizzenpunkte sind dann zwar vorhanden, das Feature Bohrung wird auf diese aber nicht mehr angewendet. Händisch würde man dann das Feature Bohrung bearbeiten die verlorenen Skizzenpunkte neu markieren und somit wären die Bohrungen wieder vollständig. Genau diesen Vorgang möchte ich nun mit VBA ausführen. Also dem bereits vorhandenen HoleFeature die Skizzenpunkt aus der aktualisierten Skizze neu zuweisen. Hierzu habe ich zunächst ein Collection Object erstellt was die Bohrungspunkte aus der Skizze einsammelt. Klappt auch. 'Create an object collection for the hole center points. Dim oHoleCenters As ObjectCollection Set oHoleCenters = ThisApplication.TransientObjects.CreateObjectCollection 'Collection Object der vorhandenen Bohrungen erstellen Set oSketchPoints = oHoleFeature.Sketch.SketchPoints For Each oSketchPoint In oSketchPoints If oSketchPoint.HoleCenter Then oHoleCenters.Add oSketchPoint End If Next oHoleFeature ist hierbei das Bohrungs Feature welches ich bearbeiten möchte mit der damit verbundenen Skizze Der zweite Teil dieses Collection Object dem Object oHoleFeature.HoleCenterPoints zuzuweisen gelingt mir nicht. Weder als ganzes Collection Object noch als einzelne Punkte. HoleCenterPoints lässt sich weder mit .Add noch .Clear bearbeiten. Auch einzelne Punkte (Item) lassen sich nicht löschen oder hinzufügen. Im Moment behelfe ich mir dadurch das ich das gesamte HoleFeature lösche und danach neu erstelle. Das hat dann aber auch wieder seine Tücken da ich alle Eigenschaften der Bohrung (HoleFeature) zunächst sichern muss um die Bohrung 1:1 mit neuen Punkten wieder neu zu erstellen. Es muss doch möglich sein nur die HoleCenterPoints wieder neu zu definieren!? Hat jemand eine Idee? Viele Grüße Martin Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Chris 31 Mitglied Konstrukteur und Mädchen für alles
Beiträge: 575 Registriert: 23.04.2013 Inventor 2013/2015 Windows 7 64 bit 16GB RAM nVidia Quadro 600
|
erstellt am: 26. Apr. 2016 12:55 <-- editieren / zitieren --> Unities abgeben: Nur für 3DCS
Hallo Martin, es wäre schön zu wissen, wie du es denn bisher versucht hast, die neuen Punkte zu zufügen. Hast du zum Beispiel diesen Befehl verwendet? Code: HoleFeatures.CreateSketchPlacementDefinition( HoleCenterPoints As ObjectCollection ) As SketchHolePlacementDefinition
Wenn ja, dann könnte man das ausschließen und auf die Suche nach anderen Möglichkeiten gehen. ------------------ MFG Chris Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
3DCS Mitglied Konstrukteur, Programmierer
Beiträge: 10 Registriert: 13.06.2015 Inventor,AutoCad,TurboCad,MS Access,mySQL
|
erstellt am: 26. Apr. 2016 13:36 <-- editieren / zitieren --> Unities abgeben:
Hallo Chris, du hast recht, hier der Code im Zusammenhang. Sub Activate_Holes_Test() 'Aktivieren aller Skizzenpunkte die als HoleCenter verwendet werden können (Kreuz in Skizze) und die 'nicht referenziert sind 'Makro soll alle Bohrungen in der ipt regenerieren, daher die For Each oHoleFeature Schleife Dim oDoc As Document Set oDoc = ThisApplication.ActiveDocument Dim oFeatures As PartFeatures Set oFeatures = oDoc.ComponentDefinition.Features Dim oHoleFeatures As HoleFeatures Set oHoleFeatures = oFeatures.HoleFeatures Dim oHoleFeature As HoleFeature Dim oSketchPoint As SketchPoint Dim oSketchPoints As SketchPoints 'Create an object collection for the hole center points. Dim oHoleCenters As ObjectCollection Set oHoleCenters = ThisApplication.TransientObjects.CreateObjectCollection For Each oHoleFeature In oHoleFeatures oHoleCenters.Clear 'Collection Object der vorhandenen Bohrungen erstellen Set oSketchPoints = oHoleFeature.Sketch.SketchPoints For Each oSketchPoint In oSketchPoints If oSketchPoint.HoleCenter Then oHoleCenters.Add oSketchPoint End If Next Call oHoleFeatures.CreateSketchPlacementDefinition(oHoleCenters) 'wirkt sich nicht aus 'Hier müsste m.E. eigentlich was in der Art 'oHoleFeature.Set.... stehen, aber da finde ich nichts passendes 'auch die Items einzeln zu setzen klappt nicht Next End Sub Grüße Martin
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Chris 31 Mitglied Konstrukteur und Mädchen für alles
Beiträge: 575 Registriert: 23.04.2013 Inventor 2013/2015 Windows 7 64 bit 16GB RAM nVidia Quadro 600
|
erstellt am: 26. Apr. 2016 16:13 <-- editieren / zitieren --> Unities abgeben: Nur für 3DCS
Zitat: Original erstellt von 3DCS:
Call oHoleFeatures.CreateSketchPlacementDefinition(oHoleCenters) 'wirkt sich nicht aus
Call oHoleFeature.CreateSketchPlacementDefinition(oHoleCenters) Ohne 's'. Kopierfehler? ------------------ MFG Chris Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
GeorgK Mitglied
Beiträge: 619 Registriert: 06.06.2001
|
erstellt am: 26. Apr. 2016 16:14 <-- editieren / zitieren --> Unities abgeben: Nur für 3DCS
|
3DCS Mitglied Konstrukteur, Programmierer
Beiträge: 10 Registriert: 13.06.2015 Inventor,AutoCad,TurboCad,MS Access,mySQL
|
erstellt am: 26. Apr. 2016 16:23 <-- editieren / zitieren --> Unities abgeben:
@ Chris das produziert einen Laufzeitfehler 438 @GeorgK ' Create the hole feature. Call oCompDef.Features.HoleFeatures.AddDrilledByThroughAllExtent( _ oHoleCenters, "1 cm", kPositiveExtentDirection) Damit kann ich dann ein neues HoleFeature machen. Das funktionier auch, will ich aber nicht. Ich will lediglich die Skizzenpunkte aktualisieren. Neu machen wäre ja nicht so schlimm wenn es nicht so viele Varianten des HoleFeatures gäbe. weitere Versuche die nichts bringen: Dim oHolePlacement As SketchHolePlacementDefinition ...... 'Set oHolePlacement = oHoleFeatures.CreateSketchPlacementDefinition(oHoleCenters) 'Das hat alles keine Auswirkung 'Call oHoleFeature.PlacementDefinition.HoleCenterPoints.Add(oHolePlacement) 'Call oHoleFeature.HoleCenterPoints.Add(oHolePlacement) 'Call oHoleFeature.HoleCenterPoints.Add(oHoleFeature.Sketch.SketchPoints)
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Ticky72 Mitglied
Beiträge: 35 Registriert: 17.02.2016 Inventor 2019 Win7 64Bit
|
erstellt am: 26. Apr. 2016 21:44 <-- editieren / zitieren --> Unities abgeben: Nur für 3DCS
Hallo Martin, hab dein Problem gesehen und gemerkt, das ich mich vor einigen Monaten auch schon mal damit beschäftigen mußte. Habs damals auch nicht hinbekommen. Jetzt noch mal ein Versuch. Bei folgendem Beispiel hab ich zur einfachen Auswahl eines bestimmten Bohrungsfeatures die Pick-Methode gewählt. Code:
Sub Aktualisieren_Bohrungsfeature()Dim oDoc As Document Set oDoc = ThisApplication.ActiveDocument Dim oCmdMgr As CommandManager Set oCmdMgr = ThisApplication.CommandManager Dim oFeatureObject As Object Set oFeatureObject = oCmdMgr.Pick(kPartFeatureFilter, "Bitte Bohrungsfeature auswählen") If oFeatureObject Is Nothing Then Exit Sub End If If Not oFeatureObject.Type = kHoleFeatureObject Then MsgBox ("Keine Bohrungsfeature ausgewählt") Exit Sub End If Dim oHolefeature As HoleFeature Set oHolefeature = oFeatureObject Dim oCollection As ObjectCollection Set oCollection = ThisApplication.TransientObjects.CreateObjectCollection Dim oSketchpoint As SketchPoint For Each oSketchpoint In oHolefeature.Sketch.SketchPoints If oSketchpoint.HoleCenter Then Call oCollection.Add(oSketchpoint) End If Next 'oHolefeature.HoleCenterPoints.Clear oHolefeature.HoleCenterPoints = oCollection End Sub
Habs nur kurz getestet, hoffe es funktioniert. Grüße Helmut 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. Apr. 2016 23:27 <-- editieren / zitieren --> Unities abgeben: Nur für 3DCS
Nabend Dann mach mal so: Code: Option ExplicitSub Activate_Holes_Test() 'Aktivieren aller Skizzenpunkte die als HoleCenter verwendet werden können (Kreuz in Skizze) und die 'nicht referenziert sind 'Makro soll alle Bohrungen in der ipt regenerieren, daher die For Each oHoleFeature Schleife Dim oDoc As Document Set oDoc = ThisApplication.ActiveDocument Dim oFeatures As PartFeatures Set oFeatures = oDoc.ComponentDefinition.Features Dim oHoleFeatures As HoleFeatures Set oHoleFeatures = oFeatures.HoleFeatures Dim oHoleFeature As HoleFeature Dim oSketchPoint As SketchPoint Dim oSketchPoints As SketchPoints 'Create an object collection for the hole center points. Dim oHoleCenters As ObjectCollection Set oHoleCenters = ThisApplication.TransientObjects.CreateObjectCollection For Each oHoleFeature In oHoleFeatures oHoleCenters.Clear 'Collection Object der vorhandenen Bohrungen erstellen Set oSketchPoints = oHoleFeature.Sketch.SketchPoints For Each oSketchPoint In oSketchPoints If oSketchPoint.HoleCenter Then oHoleCenters.Add oSketchPoint End If Next oHoleFeature.HoleCenterPoints = oHoleCenters Next End Sub
------------------ MfG Ralf Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Ticky72 Mitglied
Beiträge: 35 Registriert: 17.02.2016 Inventor 2019 Win7 64Bit
|
erstellt am: 27. Apr. 2016 10:07 <-- editieren / zitieren --> Unities abgeben: Nur für 3DCS
Hallo Ralf, ich weiß, ich hätte mich mehr auf Martins Code beziehen sollen, aber um eine Verwechslung HoleFeature zu Holefeatures zu vermeiden, habe ich mich entschieden, das ganze neu aufzubauen. Außerdem sehe ich es problematisch, immer alle Bohrungsfeatures zu aktualisieren. Hab mir jetzt ein Modul zusammengestellt, so wie ich es brauche. Vielleicht kanns mal wer brauchen. Habs nur kurz getestet, darum gebe ich keine Garantie, daß es fehlerfrei läuft.
Code:
' Überprüft ob eine Variable definiert ist bevor man sie benutzt Option Explicit' --------Aufruf Bohrungsfeature aktualisieren Sub Aufruf_Bohrungsfeature_aktualisieren() Dim oHolefeature As HoleFeature Set oHolefeature = Finde_Bohrungsfeature("Bohrung1") If Not oHolefeature Is Nothing Then 'Hier kann man dann noch einen Aufruf zum ändern der BohrungsSkizzenPunkte einfügen! 'z.B. Call Punkte_auf_Skizze_einfuegen(oHolefeature) 'noch nicht programmiert!! Call Bohrungsfeature_aktualisieren(oHolefeature) End If End Sub ' --------Bohrungsfeature aktualisieren Sub Bohrungsfeature_aktualisieren(oHolefeature As HoleFeature) Dim oCollection As ObjectCollection Set oCollection = ThisApplication.TransientObjects.CreateObjectCollection Dim oSketchpoint As SketchPoint For Each oSketchpoint In oHolefeature.Sketch.SketchPoints If oSketchpoint.HoleCenter Then Call oCollection.Add(oSketchpoint) End If Next oHolefeature.HoleCenterPoints = oCollection End Sub ' -------- Finde Bohrungsfeature mit Namen Function Finde_Bohrungsfeature(sName As String) As HoleFeature Dim oHolefeature As HoleFeature For Each oHolefeature In ThisApplication.ActiveDocument.ComponentDefinition.Features.HoleFeatures If UCase(oHolefeature.Name) = UCase(sName) Then Set Finde_Bohrungsfeature = oHolefeature Exit Function End If Next Set Finde_Bohrungsfeature = Nothing 'MsgBox ("Bohrungsfeature '" & sName & "' nicht gefunden!") End Function
Viele Grüße Helmut Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
3DCS Mitglied Konstrukteur, Programmierer
Beiträge: 10 Registriert: 13.06.2015 Inventor,AutoCad,TurboCad,MS Access,mySQL
|
erstellt am: 27. Apr. 2016 10:55 <-- editieren / zitieren --> Unities abgeben:
|