Forum:Inventor VBA
Thema:SelectSet weiter verwenden
Möchten Sie sich registrieren?
Wer darf antworten? Registrierte Benutzer können Beiträge verfassen.
Hinweise zur Registrierung Sie müssen registriert sein, um Beiträge oder Antworten auf Beiträge schreiben zu können.
Ihr Benutzername:
Ihr Kennwort:   Kennwort vergessen?
Anhang:    Datei(en) anhängen  <?>   Anhänge bearbeiten  <?>
Grafik für den Beitrag:                                                
                                                       
Ihre Antwort:

Fachbegriff
URL
Email
Fett
Kursiv
Durchgestr.
Liste
*
Bild
Zitat
Code

*HTML ist AUS
*UBB-Code ist AN
Smilies Legende
Netiquette

10 20 40

Optionen Smilies in diesem Beitrag deaktivieren.
Signatur anfügen: die Sie bei den Voreinstellungen angegeben haben.

Wenn Sie bereits registriert sind, aber Ihr Kennwort vergessen haben, klicken Sie bitte hier.

Bitte drücken Sie nicht mehrfach auf "Antwort speichern".

*Ist HTML- und/oder UBB-Code aktiviert, dann können Sie HTML und/oder UBB Code in Ihrem Beitrag verwenden.

T H E M A     A N S E H E N
SKYSURFER

Beiträge: 339 / 0

WIN XP PRO SP2,
AMD 64 3200
2* 512MB DDR400
ATI 9600XT
AIP 2008 SP3

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

KraBBy

Beiträge: 43 / 0

Inventor Professional 2016
Win7

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

SKYSURFER

Beiträge: 339 / 0

WIN XP PRO SP2,
AMD 64 3200
2* 512MB DDR400
ATI 9600XT
AIP 2008 SP3

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

SKYSURFER

Beiträge: 339 / 0

WIN XP PRO SP2,
AMD 64 3200
2* 512MB DDR400
ATI 9600XT
AIP 2008 SP3

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

BernoAn

Beiträge: 114 / 0

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

Ticky72

Beiträge: 26 / 0

Inventor 2016
Win7 64Bit

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.]

Ticky72

Beiträge: 26 / 0

Inventor 2016
Win7 64Bit

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.]

(c)2017 CAD.de