Hot News aus dem CAD.de-Newsletter:

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
Autor Thema:   SelectSet weiter verwenden (98 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: 323
Registriert: 27.08.2004

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

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: 19
Registriert: 19.09.2007

Inventor Professional 2016
Win7

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: 323
Registriert: 27.08.2004

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

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: 323
Registriert: 27.08.2004

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

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: 107
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

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)2017 CAD.de