Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Inventor VBA
  SelectSet weiter verwenden

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
Autor Thema:  SelectSet weiter verwenden (1610 mal gelesen)
SKYSURFER
Mitglied
Maschinenbautechniker


Sehen Sie sich das Profil von SKYSURFER an!   Senden Sie eine Private Message an SKYSURFER  Schreiben Sie einen Gästebucheintrag für SKYSURFER

Beiträge: 361
Registriert: 27.08.2004

IV2016 SP2
ständiger Rechnerwechsel

erstellt am: 20. Mrz. 2017 21:34    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


skript_20170320.JPG

 
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


Sehen Sie sich das Profil von KraBBy an!   Senden Sie eine Private Message an KraBBy  Schreiben Sie einen Gästebucheintrag für KraBBy

Beiträge: 601
Registriert: 19.09.2007

Inventor Professional 2020
WinX

erstellt am: 21. Mrz. 2017 13:11    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für SKYSURFER 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von SKYSURFER an!   Senden Sie eine Private Message an SKYSURFER  Schreiben Sie einen Gästebucheintrag für SKYSURFER

Beiträge: 361
Registriert: 27.08.2004

IV2016 SP2
ständiger Rechnerwechsel

erstellt am: 21. Mrz. 2017 19:21    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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


Sehen Sie sich das Profil von SKYSURFER an!   Senden Sie eine Private Message an SKYSURFER  Schreiben Sie einen Gästebucheintrag für SKYSURFER

Beiträge: 361
Registriert: 27.08.2004

IV2016 SP2
ständiger Rechnerwechsel

erstellt am: 21. Mrz. 2017 21:50    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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



Sehen Sie sich das Profil von BernoAn an!   Senden Sie eine Private Message an BernoAn  Schreiben Sie einen Gästebucheintrag für BernoAn

Beiträge: 164
Registriert: 16.01.2014

erstellt am: 24. Mrz. 2017 13:50    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für SKYSURFER 10 Unities + Antwort hilfreich

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



Sehen Sie sich das Profil von Ticky72 an!   Senden Sie eine Private Message an Ticky72  Schreiben Sie einen Gästebucheintrag für Ticky72

Beiträge: 35
Registriert: 17.02.2016

Inventor 2019
Win7 64Bit

erstellt am: 29. Mrz. 2017 11:08    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für SKYSURFER 10 Unities + Antwort hilfreich

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



Zerspanungsmechaniker (a)

«Innovationen sind gefragt, um unsere Erde lebenswert zu erhalten. Und wir sind ganz vorne mit dabei: Unsere Hightech-Sensoren machen rund um den Globus Maschinen leistungsfähiger und Fabriken smarter. Vor allem helfen sie, kostbare Ressourcen zu schonen. Das fasziniert mich. Wir sind der richtige Ort für alle, die mit uns in einer inspirierenden und wertschätzenden Arbeitsumgebung die Zukunft gestalten wollen....

Anzeige ansehenMechaniker
Ticky72
Mitglied



Sehen Sie sich das Profil von Ticky72 an!   Senden Sie eine Private Message an Ticky72  Schreiben Sie einen Gästebucheintrag für Ticky72

Beiträge: 35
Registriert: 17.02.2016

Inventor 2019
Win7 64Bit

erstellt am: 29. Mrz. 2017 12:31    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für SKYSURFER 10 Unities + Antwort hilfreich

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz