Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  CATIA V5 Programmierung
  Mehrfacbearbeitung von Produkt/Part verhindern

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:  Mehrfacbearbeitung von Produkt/Part verhindern (1734 mal gelesen)
moppesle
Ehrenmitglied V.I.P. h.c.
Konstrukteur


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

Beiträge: 3418
Registriert: 28.05.2009

CATIA V5 R19 SP9
WIN 7 64bit

erstellt am: 28. Aug. 2017 10:27    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 zusammen,

es wird in meinem Makro Rekursiv eine Produktstruktur abgearbeitet.

Nun möchte ich eine Mehrfachbearbeitung von Gleichteilen verhindern.

Habe mir das in etwas so vorgestellt.

-Produkt/Partname in ein Array schreiben.
-Vor Aufruf der Funktion zur Bearbeitung der Produkte/Parts den Namen das aktuellen Produkt/Part vergleichen.
-Wenn Name schon vorhanden Bearbeitung überspringen.

Hat vielleicht jemand ein Beispiel für mich.


Danke euch.

------------------
Gruß Uwe

Auch Catia ist nur ein Mensch!    

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

bgrittmann
Moderator
Konstrukteur


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

Beiträge: 11780
Registriert: 30.11.2006

CATIA V5R19

erstellt am: 28. Aug. 2017 10:42    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 moppesle 10 Unities + Antwort hilfreich

Servus Uwe

Geht zB über ein Dictionary (VBA siehe zB hier) oder über eine entsprechende Class (auch unter CATScript siehe hier).

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

C.Samer
Mitglied
CAD Administrator


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

Beiträge: 72
Registriert: 03.05.2017

erstellt am: 28. Aug. 2017 17:28    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 moppesle 10 Unities + Antwort hilfreich

Hallo!

Wenn es darum geht z.B. die Anzahl von Schrauben in der aktuellen Baugruppe herauszufinden, lässt sich das so machen:

Code:
save = 0
If paProductsCount > 0 Then 'Wenn ich mehrere siblings habe
    For intH = 1 To paProductsCount
        If pLoc.partnumber = paProducts.Item(intH).PartNumber Then 'Wenn meine Teilenummer gleich der Teilenummer
                                                                   'des Kindes intH meines Elternteils ist, dann...
            duplicates = duplicates + 1
            If pLoc.Name = paProducts.Item(intH).Name and duplicates = 1 Then 'Wenn mein Exemplarname gleich dem Exemplarnamen
                                                                              'des Kindes intH meines Elternteils ist, und noch
                                                                              'keine Duplikate vorgekommen sind, dann...
                save = 1
            Else
                If save = 0 Then
                    Exit For
                End If
            End If
        End If
    Next
Else 'Wenn ich keine siblings habe
    duplicates = 1
End If

If save = 1 then
    'speichern
End if


Pa ist das Parent von pLoc (aktueller Teil). Der Code geht durch alle Kinder des Parent von pLoc durch und addiert dann die Duplikate. Wenn sowohl die Teilenummer des betrachteten Teils, als auch der Exemplarname gleich sind, weiß der Code, dass es sich um das Original handelt. Daraufhin weiß er, dass er den Artikel in einer beliebigen Liste speichern soll (Variable save = 1). Ansonsten bricht er das Speichern des Teils ab. Er zählt alle Duplikate (Siblings) bis zum Ende und wenn dann save = 1 ist, führt er die Speicherfunktion aus.

Das was Bernd meint, geht übrigens so:

Code:
Class objType
    Public artNr As String 'Artikelnummer / PartNumber
    Public bez As String 'Bezeichnung / Definition
    Public menge As String 'Menge
End Class

Dim objArr() As objType

Sub CATMain()
    ReDim objArr(0) 'Initialize the Array
    objLenY = -1 'Kein Header, daher direkt auf 0 Werte schreiben
End Sub

Function CreateObjBOM(p as Product)
    objLenY = objLenY + 1 'Beim ersten mal -1 + 1 = 0 ; ObjArr am anfang (0)
    ReDim Preserve objArr(objLenY)
    Set objArr(objLenY) = New objType
    Set objArr(objLenY).artNr = pLoc.PartNumber
End Function


Hab den Code nicht getestet, aber so ähnlich bei mir in Verwendung.
Ich denke er hilft dir trotzdem weiter.

Liebe Grüße aus Wien,
Christoph     

[Diese Nachricht wurde von C.Samer am 29. Aug. 2017 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

moppesle
Ehrenmitglied V.I.P. h.c.
Konstrukteur


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

Beiträge: 3418
Registriert: 28.05.2009

CATIA V5 R19 SP9
WIN 7 64bit

erstellt am: 29. Aug. 2017 08:29    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 euch beiden,

Danke für die Info

Ich Schaue mir das mal an.
Bestimmt werde ich mich auch nochmal melden.  

------------------
Gruß Uwe

Auch Catia ist nur ein Mensch!    

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

moppesle
Ehrenmitglied V.I.P. h.c.
Konstrukteur


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

Beiträge: 3418
Registriert: 28.05.2009

CATIA V5 R19 SP9
WIN 7 64bit

erstellt am: 09. Sep. 2017 11:45    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,

habe mir das Makro von Henry angeschaut.

Leider stockt das ganze schon am Anfang bei "Class MyDictionary"
mit der Meldung "Only comments may appear after End Sub, End Function, or End Property"

Was hat das zu bedeutet, das "End Class" am Ende des Codes rot dargestellt wird.

Code:
Sub CATMain()
Dim New_MyDictionary
Dim cars 'As New MyDictionary
Set cars = New_MyDictionary
Call cars.add("a", "Alvis")
Call cars.add("b", "Buick")
Call cars.add("c", "Cadillac")
MsgBox "The value corresponding to the key 'b' is " & cars.item("b")
   
End Sub

Class MyDictionary
Private m_arrSKeys()        'As String                              ' Liste der benutzten Keys
Private m_arrVarValues()    'As Variant                              ' Liste der zugeordneten Objekte
Private m_lCount            'As Long                                ' Anzahl enthaltender Elemente

' Konstruktor
Private Sub Class_Initialize()

    m_lCount = 0

End Sub

' Methode zum Hinzufügen von neuen Elementen
Public Function add(ByVal i_sKey, ByRef i_varValue) '(ByVal i_sKey As String, ByRef i_varValue As Variant) As Boolean

   
    add = False
   
    ' Wenn Key schon existiert, dann raus
    If (Me.exists(i_sKey) = True) Then Exit Function
   
    ' Arrays um eins erweitern
    ReDim Preserve m_arrSKeys(m_lCount)
    ReDim Preserve m_arrVarValues(m_lCount)
    m_arrSKeys(m_lCount) = i_sKey
    If (IsObject(i_varValue)) Then
        Set m_arrVarValues(m_lCount) = i_varValue
    Else
        m_arrVarValues(m_lCount) = i_varValue
    End If
   
    m_lCount = m_lCount + 1
   
    add = True

End Function

' Methode zum Entfernen von Elementen
' der Key-Name wird übergben
Public Sub remove(ByRef i_sKey) '(ByRef i_sKey As String)

    Dim arrSBuffer()    'As String
    Dim arrVarBuffer()  'As Variant
    Dim lItem          'As Long
    Dim lItemAdd        'As Long
    Dim lUBound        'As Long
   
    ' Wenn Key nicht existiert, dann raus
    If (Me.exists(i_sKey) = False) Then Exit Sub
   
    ' Anzahl Einträge ermitteln
    lUBound = Me.count - 1
   
    ' Puffer festlegen
    ReDim arrSBuffer(lUBound)
    ReDim arrVarBuffer(lUBound)
   
    ' Alte-Werte ohne Eintrag in den Puffer schreiben
    lItemAdd = 0
    For lItem = 0 To lUBound
   
        If (Not m_arrSKeys(lItem) = i_sKey) Then
       
            If (IsObject(m_arrVarValues(lItem))) Then
           
                Set arrVarBuffer(lItemAdd) = m_arrVarValues(lItem)
               
            Else
           
                arrVarBuffer(lItemAdd) = m_arrVarValues(lItem)
           
            End If
           
            arrSBuffer(lItemAdd) = m_arrSKeys(lItem)
            lItemAdd = lItemAdd + 1
           
        End If
   
    Next 'lItem
   
    ' Puffer in Array-Values zurückschreiben
    m_arrVarValues = arrVarBuffer
    ' Puffer in Array-Values zurückschreiben
    m_arrSKeys = arrSBuffer
    ' Count runterzählen
    m_lCount = m_lCount - 1

End Sub

' methode um alle Elemente zu entfernen
Public Sub removeAll()
    m_lCount = 0
'    On Error Resume Next
'        ReDim m_arrSKeys(-1)
'        ReDim m_arrVarValues(-1)
'    On Error GoTo 0
    Erase m_arrSKeys
    Erase m_arrVarValues
End Sub

' Methode um zu überprüfen ob ein Key bereits existiert
Public Function exists(ByRef i_sKeyName) '(ByRef i_sKeyName As String) As Boolean

    Dim varSKeyWork    'As Variant
   
    exists = False
   
    If (Me.count > 0) Then
   
        For Each varSKeyWork In m_arrSKeys
       
            If (varSKeyWork = i_sKeyName) Then
           
                exists = True
                Exit For
           
            End If
       
        Next 'varSKeyWork

    End If
   
End Function

' Methode um die Anzahl der Elemente zu ermitteln
Public Property Get count() 'As Long

'    On Error Resume Next
'        count = UBound(m_arrSKeys)
'        If (Not Err.Number = 0) Then count = 0
'    On Error GoTo 0
    count = m_lCount
   
End Property

' Methode um ein Element, dessen Key bekannt ist, zu erhalten
Public Function item(ByVal i_sKey) '(ByVal i_sKey As String) As Variant

    Dim lCount  'As Long
    Dim lItem  'As Long

    item = vbNullString
    lCount = Me.count
   
    If (lCount > 0) Then
   
        For lItem = 0 To lCount - 1
       
            If (i_sKey = m_arrSKeys(lItem)) Then
           
                item = m_arrVarValues(lItem)
                Exit For
           
            End If
       
        Next 'lItem
   
    End If

End Function

' Methode um ein Element, dessen Nummer bekannt ist, zu erhalten
Public Function itemByNumber(ByVal i_lItem) '(ByVal i_lItem As Long) As Variant

    If (i_lItem <= m_lCount) Then
   
        Set itemByNumber = m_arrVarValues(i_lItem)
       
    Else
   
        Set itemByNumber = Nothing
       
    End If
   
End Function

' Methode um den Namen eines Keys zu ändern
Public Function changeKeyName(ByRef i_sOldKeyName, ByRef i_sNewKeyName) '(ByRef i_sOldKeyName As String, ByRef i_sNewKeyName As String) As Boolean

    changeKeyName = False
   
    If (Me.exists(i_sNewKeyName)) Then Exit Function
   
    Dim lCount  'As Long
    Dim lItem  'As Long

    item = vbNullString
    lCount = Me.count
   
    If (lCount > 0) Then
   
        For lItem = 0 To lCount - 1
       
            If (i_sOldKeyName = m_arrSKeys(lItem)) Then
           
                m_arrSKeys(lItem) = i_sOldKeyName
                changeKeyName = True
                Exit For
           
            End If
       
        Next 'lItem
   
    End If

End Function

' Methode um alle Keys, als Liste zu erhalten
Public Function keys() 'As String()

    keys = m_arrSKeys

End Function

' Methode um alle Items, als Liste zu erhalten
Public Function items() 'As Variant()

    items = m_arrVarValues

End Function

Private Sub Class_Terminate()

    Erase m_arrSKeys
    Erase m_arrVarValues

End Sub
End Class


------------------
Gruß Uwe

Auch Catia ist nur ein Mensch!    

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

bgrittmann
Moderator
Konstrukteur


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

Beiträge: 11780
Registriert: 30.11.2006

CATIA V5R19

erstellt am: 09. Sep. 2017 11:54    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 moppesle 10 Unities + Antwort hilfreich

Servus Uwe

Programmierst du in VBA?
Dann kannst du direkt ein Dictonary nutzen und brauchst wohl die Klasse nicht.

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

moppesle
Ehrenmitglied V.I.P. h.c.
Konstrukteur


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

Beiträge: 3418
Registriert: 28.05.2009

CATIA V5 R19 SP9
WIN 7 64bit

erstellt am: 09. Sep. 2017 12:03    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 Bernd,

das Makro soll später als CATScript laufen.

Bin total auf dem Holzweg.

------------------
Gruß Uwe

Auch Catia ist nur ein Mensch!    

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

bgrittmann
Moderator
Konstrukteur


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

Beiträge: 11780
Registriert: 30.11.2006

CATIA V5R19

erstellt am: 09. Sep. 2017 12:13    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 moppesle 10 Unities + Antwort hilfreich

Servus
In VBA müsstest du wahrscheinlich den Code der Klasse in eine Class (statt ein Modul eine Class anlegen) ablegen. Im CATScript kommt alles in eine Datei.
Schau dir mal dieses Function an. Sollte für dein Vorhaben schon reichen.

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

C.Samer
Mitglied
CAD Administrator


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

Beiträge: 72
Registriert: 03.05.2017

erstellt am: 13. Sep. 2017 14:33    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 moppesle 10 Unities + Antwort hilfreich

Probier doch mal meinen Code! Der sollte in CATScript funktionieren!   

Grüße aus Wien,
Christoph

[Diese Nachricht wurde von C.Samer am 13. Sep. 2017 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

moppesle
Ehrenmitglied V.I.P. h.c.
Konstrukteur


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

Beiträge: 3418
Registriert: 28.05.2009

CATIA V5 R19 SP9
WIN 7 64bit

erstellt am: 13. Sep. 2017 16:25    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 Christoph,

habe es mit Bernd´s Hilfe hinbekommen.

Danke

------------------
Gruß Uwe

Auch Catia ist nur ein Mensch!    

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

C.Samer
Mitglied
CAD Administrator


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

Beiträge: 72
Registriert: 03.05.2017

erstellt am: 17. Nov. 2017 09:39    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 moppesle 10 Unities + Antwort hilfreich

Hallo!

Da ich's gerade selbst nocheinmal brauche, habe ich den Code von Bernds Link in CATScript umgeschrieben (Error Handling hab ich rausgenommen):

Code:
Function IsInArray(sArray() As String, sItem As String) As Long
    Dim iStart As Long : iStart = LBound(sArray)
    Dim iEnd As Long : iEnd = UBound(sArray)
    Dim iIndex As Long
    Dim iLen As Long

    iIndex = -1
    iLen = Len(sItem)
    For i = iStart To iEnd
        If Len(sArray(i)) = iLen Then
            If sArray(i) = sItem Then
                iIndex = i
                Exit For
            End If
        End If
    Next

    IsInArray = iIndex
End Function

und

Code:
Dim sData() As String
If IsInArray(sData,p.partNumber) < 0 Then
    ReDim Preserve sData(UBound(sData) + 1)
    sData(UBound(sData)) = p.partNumber
    MsgBox p.partNumber
End If

Macht eigentlich das selbe wie mein Code oben, ist aber doch etwas übersichtlicher  

Liebe Grüße aus Wien,
Christoph

[Diese Nachricht wurde von C.Samer am 17. Nov. 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