| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
| |
| Request a special discount on NVIDIA RTX 5000 Ada Generation GPU !, eine Pressemitteilung
|
Autor
|
Thema: SelectSet weiter verwenden (1655 / mal gelesen)
|
SKYSURFER Mitglied Maschinenbautechniker
Beiträge: 361 Registriert: 27.08.2004 IV2016 SP2 ständiger Rechnerwechsel
|
erstellt am: 20. Mrz. 2017 21:34 <-- editieren / zitieren --> Unities abgeben:
Hallo, ich möchte einen Arbeitsablauf etwas performanter gestalten. Hierfür arbeite ich an einem Makro. Der User muss in einem Bauteil min. eine Skizze auswählen. Diese Auswahl kommt dann in ein Select Set
Code: 'Skizzen ausgewählt? Dim oSelectSet As SelectSet Set oSelectSet = oSourcePartDoc.SelectSet Dim colSketch As New Collection Dim I As Long 'Prüfen, ob SelectSet größer null For I = 1 To oSelectSet.Count 'hier die Arbeit 'Nur Skizzen zum SelectSet hinzufügen If TypeOf oSelectSet.Item(I) Is Sketch Then colSketch.Add oSelectSet.Item(I) End If Next
'Zähler wieder auf Null I = 0 'prüfen, ob SelectSet mit Skizzen größer null If colSketch.Count = 0 Then MsgBox "keine Skizzen in der Auswahl. Ende" GoTo Ende End If
Wenn ich dann aber das SelectSet in einem abgeleitetem Bauteil verwenden möchte, klappt das nicht:
Code: ' Create a derived definition for the molded part. Dim oDerivedPartDef As DerivedPartUniformScaleDef Set oDerivedPartDef = oDocPartNew.ComponentDefinition.ReferenceComponents.DerivedPartComponents.CreateUniformScaleDef(sSourcePartDocFilePath) 'erstmal alles deaktivieren oDerivedPartDef.ExcludeAll ' Set the scale to use. oDerivedPartDef.ScaleFactor = 1.1 'Skizzen hinzufügen 'http://adndevblog.typepad.com/manufacturing/2012/06/includeexclude-parameters-from-the-base-part-in-a-derived-part.html Dim oDerEntity As DerivedPartEntity For Each oDerEntity In oDerivedPartDef.Sketches MsgBox "in der For-Schleife" 'bis hierhin funktioniert es noch If (oDerEntity.ReferencedEntity.Name = colSketch.Item(I)) Then MsgBox "in der Add-Stelle" 'oDerEntity.IncludeEntity 'hier funktioniert das auch nicht Exit For 'oder next? End If Next
Bis zu "MsgBox "in der For-Schleife"" funktioniert es noch, danach kommt ein Fehler. Als Fehler wird die Zeile:
Code: If (oDerEntity.ReferencedEntity.Name = colSketch.Item(I)) Then
angezeigt. Hat jemand einen Tipp für mich? Besten Dank und Gruß SKYSURFER
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
KraBBy Mitglied Maschinenbau-Ingenieur
Beiträge: 720 Registriert: 19.09.2007 Inventor Professional 2020 WinX
|
erstellt am: 21. Mrz. 2017 13:11 <-- editieren / zitieren --> Unities abgeben: Nur für SKYSURFER
Hallo Skysurfer, ist der Zähler I am Ende korrekt gesetzt? In deinem Beitrag setzt Du ihn weiter oben auf I=0. Dadurch funktioniert der Aufruf nicht. Ich habe ihn in meinem Beispiel einfach auf 1 gesetzt. Außerdem ist IncludeEntity ein Bool, deshalb auf True. Vielleicht hilft Dir das weiter. Code: If (oDerEntity.ReferencedEntity.Name = colSketch.Item(1).Name) Then oDerEntity.IncludeEntity = True 'das läuft bei mir durch Exit For End If
Mein Beispiel läuft dann zumindest ohne Fehler durch. Allerdings ohne echtes Ergebnis, da mir die Info fehlt, was eigentlich passieren soll.
------------------ Gruß KraBBy Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
SKYSURFER Mitglied Maschinenbautechniker
Beiträge: 361 Registriert: 27.08.2004 IV2016 SP2 ständiger Rechnerwechsel
|
erstellt am: 21. Mrz. 2017 19:21 <-- editieren / zitieren --> Unities abgeben:
Hallo KraBBy, besten Dank für deine Rückmeldung. Ich habe das mal in mein Skript eingebaut. Einige Dinge funktionieren nun, andere nicht... Hier meine Beschreibung: Das funktioniert: - mehrere Skizzen (inkl. der ersten) im Originalbauteil auswählen - colSketch liefert ein richtiges Ergebnis, da Zeile "MsgBox colSketch.Count" passt. - Das funktioniert nicht: - Es wird immer nur die erste Skizze in die AK übertragen. - z.B. nur die zweite Skizze auswählen. Dann erfolgt ein Absturz vom IV. Code: Private Sub AK_Skizzen() If ThisApplication.Documents.Count = 0 Then MsgBox "Es ist kein Dokument geöffnet!" Exit Sub End If Dim oSourcePartDoc As Document Set oSourcePartDoc = ThisApplication.ActiveDocument ' Ist das Dokument ein IPT ? If oSourcePartDoc.DocumentType <> kPartDocumentObject Then MsgBox "Funktion nur in einer ipt gültig!" Exit Sub Else 'hier geht es nun los... Dim sSourcePartDocFilePath As String Dim sSourcePartDocFileName As String If oSourcePartDoc.FullFileName = "" Then MsgBox "Originaldatei ist noch nicht gespeichert. Bitte erst speichern!" GoTo Ende End If sSourcePartDocFilePath = oSourcePartDoc.FullDocumentName sSourcePartDocFileName = oSourcePartDoc.DisplayName 'testen 'MsgBox sSourcePartDocFilePath 'MsgBox sSourcePartDocFileName 'Skizzen ausgewählt? Dim oSelectSet As SelectSet Set oSelectSet = oSourcePartDoc.SelectSet Dim colSketch As New Collection Dim I As Long For I = 1 To oSelectSet.Count 'hier die Arbeit 'Nur Skizzen zum SelectSet hinzufügen If TypeOf oSelectSet.Item(I) Is Sketch Then colSketch.Add oSelectSet.Item(I) End If Next MsgBox colSketch.Count 'Zähler wieder auf Eins I = 1 'prüfen, ob SelectSet mit Skizzen größer null If colSketch.Count = 0 Then MsgBox "keine Skizzen in der Auswahl. Ende" GoTo Ende End If 'neues Bauteil erstellen 'https://forums.autodesk.com/t5/inventor-customization/vba-code-to-create-inventor-part/td-p/3061640 '2. Create a new part with your desired part template Dim oProjectMgr As DesignProjectManager Set oProjectMgr = ThisApplication.DesignProjectManager Dim oProject As DesignProject Set oProject = oProjectMgr.ActiveDesignProject Dim oTemplatesPath As String oTemplatesPath = oProject.TemplatesPath Dim oDocPartNew As PartDocument Set oDocPartNew = ThisApplication.Documents.Add(kPartDocumentObject, oTemplatesPath & "\Norm.ipt", True) ' Ende neues Bauteil erstellen ' Create a derived definition for the molded part. Dim oDerivedPartDef As DerivedPartUniformScaleDef Set oDerivedPartDef = oDocPartNew.ComponentDefinition.ReferenceComponents.DerivedPartComponents.CreateUniformScaleDef(sSourcePartDocFilePath) 'erstmal alles deaktivieren oDerivedPartDef.ExcludeAll ' Set the scale to use. oDerivedPartDef.ScaleFactor = 1.1 'Skizzen hinzufügen 'http://adndevblog.typepad.com/manufacturing/2012/06/includeexclude-parameters-from-the-base-part-in-a-derived-part.html Dim oDerEntity As DerivedPartEntity For Each oDerEntity In oDerivedPartDef.Sketches 'Ich bin in der for-schleife MsgBox "in der For-Schleife" 'bis hierhin funktioniert es noch If oDerEntity.ReferencedEntity.Name = colSketch.Item(I).Name Then oDerEntity.IncludeEntity = True 'das läuft bei mir durch I = I + 1 'Bringt auch nicht den Durchbruch, weniger Fehler, wenn auskommentiert. Exit For 'Zähler eins nach oben End If Next ' We could set other options for the derived part using the derived part definition. ' In this case the defaults are good except for the scale which we changed. ' Create the derived part. 'im neuen Bauteil die AK erstellen Call oDocPartNew.ComponentDefinition.ReferenceComponents.DerivedPartComponents.Add(oDerivedPartDef) 'zoom auf alles ThisApplication.ActiveView.Fit End If Ende: End Sub
In der For-Schleife wird das "I" nicht nach oben gezählt. Hat noch jemand einen Tipp für mich?! Besten Dank. Gruß SKYSURFER
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
SKYSURFER Mitglied Maschinenbautechniker
Beiträge: 361 Registriert: 27.08.2004 IV2016 SP2 ständiger Rechnerwechsel
|
erstellt am: 21. Mrz. 2017 21:50 <-- editieren / zitieren --> Unities abgeben:
Hallo, auch mit diesem Code komme ich nicht weiter. Bei zwei Skizzen in der Auswahl schmiert mir die Kiste ab:
Code: Dim oDerEntity As DerivedPartEntity For Each oDerEntity In oDerivedPartDef.Sketches 'MsgBox "in der For-Schleife" 'bis hierhin funktioniert es noch For I = 1 To colSketch.Count If oDerEntity.ReferencedEntity.Name = colSketch.Item(I).Name Then oDerEntity.IncludeEntity = True 'das läuft bei mir durch 'I = I + 1 'Bringt auch nicht den Durchbruch, weniger Fehler, wenn auskommentiert. End If Next Exit For Next
Gruß SKYSURFER Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
BernoAn Mitglied
Beiträge: 172 Registriert: 16.01.2014
|
erstellt am: 24. Mrz. 2017 13:50 <-- editieren / zitieren --> Unities abgeben: Nur für SKYSURFER
Hallo Ich habe erstmal lange gebraucht bis überhaupt wusste was du willst. Wenn ich es richtig verstanden habe willst du eine beliebige Skizze in ein abgeleitetes Bauteil übertragen! Bei mir läuft das Script genau so wie du es hier gepostet hast. Allerdings nur wenn die Skizze die du übertragen willst auf "Skizze wiederverwenden" steht! Es funktioniert so auch mit Skizze 2 und 3 usw. Gruß Berno 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: 29. Mrz. 2017 11:08 <-- editieren / zitieren --> Unities abgeben: Nur für SKYSURFER
Hallo, ich kenne jetzt nicht den Unterschied von (New) Collection und Objectcollection. Da es sich bei Skizzen um Objekte handelt, würde ich eher die Objectcollection vorziehen. Dann würde ich mal versuchen die Schleife nicht über die Skizzen des abgeleiteten Bauteils, sondern über die Objectcollection laufen lassen. Also in etwa: For Each oObject in ocolSketch... Bin kein Profi, darum keine Garantie dafür. Schöne Grüße und viel Glück Helmut Hier die geänderten Bereiche: Alt:
Code:
Dim colSketch As New Collection Dim I As Long For I = 1 To oSelectSet.Count 'hier die Arbeit 'Nur Skizzen zum SelectSet hinzufügen If TypeOf oSelectSet.Item(I) Is Sketch Then colSketch.Add oSelectSet.Item(I) End If Nex
Neu:
Code:
Dim colSketch As ObjectCollection Set colSketch = ThisApplication.TransientObjects.CreateObjectCollection Dim oSketchObject As Object Dim I As Long For I = 1 To oSelectSet.Count If TypeOf oSelectSet.Item(I) Is Sketch Then Set oSketchObject = oSelectSet.Item(I) colSketch.Add oSketchObject End If Next
Alt:
Code:
For Each oDerEntity In oDerivedPartDef.Sketches 'Ich bin in der for-schleife MsgBox "in der For-Schleife" 'bis hierhin funktioniert es noch If oDerEntity.ReferencedEntity.Name = colSketch.Item(I).Name Then oDerEntity.IncludeEntity = True 'das läuft bei mir durch I = I + 1 'Bringt auch nicht den Durchbruch, weniger Fehler, wenn auskommentiert. Exit For 'Zähler eins nach oben End If Next
Neu: Code:
For Each oSketchObject In colSketch For Each oDerEntity In oDerivedPartDef.Sketches If oSketchObject.Name = oDerEntity.ReferencedEntity.Name Then oDerEntity.IncludeEntity = True End If Next Next
[Diese Nachricht wurde von Ticky72 am 29. Mrz. 2017 editiert.] 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: 29. Mrz. 2017 12:31 <-- editieren / zitieren --> Unities abgeben: Nur für SKYSURFER
Vielleicht doch besser den geänderten Quelltext nochmals komplett: Code:
Private Sub AK_Skizzen() If ThisApplication.Documents.Count = 0 Then MsgBox "Es ist kein Dokument geöffnet!" Exit Sub End If Dim oSourcePartDoc As Document Set oSourcePartDoc = ThisApplication.ActiveDocument ' Ist das Dokument ein IPT ? If oSourcePartDoc.DocumentType <> kPartDocumentObject Then MsgBox "Funktion nur in einer ipt gültig!" Exit Sub Else'hier geht es nun los... Dim sSourcePartDocFilePath As String Dim sSourcePartDocFileName As String If oSourcePartDoc.FullFileName = "" Then MsgBox "Originaldatei ist noch nicht gespeichert. Bitte erst speichern!" GoTo Ende End If sSourcePartDocFilePath = oSourcePartDoc.FullDocumentName sSourcePartDocFileName = oSourcePartDoc.DisplayName 'testen 'MsgBox sSourcePartDocFilePath 'MsgBox sSourcePartDocFileName 'Skizzen ausgewählt? Dim oSelectSet As SelectSet Set oSelectSet = oSourcePartDoc.SelectSet Dim colSketch As ObjectCollection Set colSketch = ThisApplication.TransientObjects.CreateObjectCollection Dim oSketchObject As Object Dim I As Long For I = 1 To oSelectSet.Count If TypeOf oSelectSet.Item(I) Is Sketch Then Set oSketchObject = oSelectSet.Item(I) colSketch.Add oSketchObject End If Next MsgBox colSketch.Count 'Zähler wieder auf Eins I = 1 'prüfen, ob SelectSet mit Skizzen größer null If colSketch.Count = 0 Then MsgBox "keine Skizzen in der Auswahl. Ende" GoTo Ende End If 'neues Bauteil erstellen 'https://forums.autodesk.com/t5/inventor-customization/vba-code-to-create-inventor-part/td-p/3061640 '2. Create a new part with your desired part template Dim oProjectMgr As DesignProjectManager Set oProjectMgr = ThisApplication.DesignProjectManager Dim oProject As DesignProject Set oProject = oProjectMgr.ActiveDesignProject Dim oTemplatesPath As String oTemplatesPath = oProject.TemplatesPath Dim oDocPartNew As PartDocument Set oDocPartNew = ThisApplication.Documents.Add(kPartDocumentObject, oTemplatesPath & "\Norm.ipt", True) ' Ende neues Bauteil erstellen ' Create a derived definition for the molded part. Dim oDerivedPartDef As DerivedPartUniformScaleDef Set oDerivedPartDef = oDocPartNew.ComponentDefinition.ReferenceComponents.DerivedPartComponents.CreateUniformScaleDef(sSourcePartDocFilePath) 'erstmal alles deaktivieren oDerivedPartDef.ExcludeAll ' Set the scale to use. oDerivedPartDef.ScaleFactor = 1.1 'Skizzen hinzufügen 'http://adndevblog.typepad.com/manufacturing/2012/06/includeexclude-parameters-from-the-base-part-in-a-derived-part.html Dim oDerEntity As DerivedPartEntity For Each oSketchObject In colSketch For Each oDerEntity In oDerivedPartDef.Sketches If oSketchObject.Name = oDerEntity.ReferencedEntity.Name Then oDerEntity.IncludeEntity = True End If Next Next ' We could set other options for the derived part using the derived part definition. ' In this case the defaults are good except for the scale which we changed. ' Create the derived part. 'im neuen Bauteil die AK erstellen Call oDocPartNew.ComponentDefinition.ReferenceComponents.DerivedPartComponents.Add(oDerivedPartDef) 'zoom auf alles ThisApplication.ActiveView.Fit End If Ende: End Sub
[Diese Nachricht wurde von Ticky72 am 29. Mrz. 2017 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |