---

Guten Abend zusammen,

ich habe mich seit kurzem mit der Makroprogrammierung auseinander gesetzt.

Stehe jetzt aber vor einem Problem das ich nicht gelöst bekomme   und hoffe auf Hilfe

Ausgangspunkt:
Ich habe ein Makro (Sub) das mir vorher definierte Parameter in ein CatPart oder CatProduct schreibt.

Ich wollte dieses jetzt erweitern, dass ich in einem Produkt durch eine Userselection eines oder mehrere Bauteile auswähle und dann mit einer For-Schleife die einzelnen Einträge der Selektion an mein Sub CreateParameters übergebe.

Ich bekomme aber die Selectioneinträge nicht so konvertiert das Sie übergeben werden. D.h. ist ein CATPart im aktiven Dokument dann klappt es wunderbar
aber sobald ich versuche die Selection zu übergeben überspringt er die Zeile einfach  

anbei der Abschnitt meines Makros:

If InStr(ActiveDoc.Name, ".CATPart") <> 0 Then
      
        CreateParameters (ActiveDoc.Product)
   
       
    ElseIf InStr(ActiveDoc.Name, ".CATProduct") <> 0 Then
   
        Dim USel As Object
        Dim Was(1)
        Dim E As String
       
        Was(0) = "Product"
        Was(1) = "Part"
        Set USel = ActiveDoc.Selection
        USel.Clear
        E = USel.SelectElement3(Was, "Ein oder mehrere Produkte/Parts auswählen", False, CATMultiSelTriggWhenUserValidatesSelection, False)
               
        If E = "Normal" Then
           MsgBox "Ausgewaehlte Elemente: " & CStr(USel.Count2), 64, Makroname + " " + version
          
           Dim number, ind As Integer
           Dim Bauteil As Variant
                                   
           number = USel.Count2
          
           For ind = 1 To number
               Set Bauteil = USel.Item2(ind).Value
               CreateParameters (Bauteil)
           Next
          
        Else
            MsgBox "Abbruch"
            Exit Sub
        End If
        USel.Clear
   
   
    Else
        MsgBox "ungültige Auswahl! Bitte ein Produkt oder Part öffnen", 16, Makroname + " " + version
        Exit Sub

    End If

und noch das Sub:

Sub CreateParameters(iProduct As Variant)

   On Error Resume Next

   Dim parameters, userParameters As parameters
   Dim param As Parameter
   Dim paramName, sInstanceName, sPartNumber As String
   Dim RefProduct As Product
   Dim nbParameters, ParaNumber, i, j As Integer
   Dim lfound As Boolean
  
  
  
   Set RefProduct = iProduct.ReferenceProduct
   Set parameters = RefProduct.parameters
   Set userParameters = RefProduct.UserRefProperties
   nbParameters = RefParameters.Count

   sInstanceName = iProduct.Name
   sPartNumber = RefProduct.Name

   Err.Clear

   ParaNumber = UBound(Trikontxtpara)
  
  
   For i = 0 To ParaNumber

        Err.Clear

        paramName = sPartNumber & "\Properties\" & Trikontxtpara(i)

'//---------------------------------------------------------------------------
'// Kontrollieren ob das Attribut bzw. Parameter bereits vorhanden ist
'//---------------------------------------------------------------------------

        lfound = False
       
        For j = 1 To userParameters.Count
            If (userParameters.Item(j).Name = paramName) Then
               lfound = True
            End If
        Next
       
        If (lfound = False) Then
           Set param = userParameters.CreateString(Trikontxtpara(i), "")
        End If
       
    Next
   
End Sub

Ich hoffe jemand versteht mein Problem und weiß die Lösung XD

Viele Grüße Wolle

------------------
Die Fantasie ist die einzige Waffe gegen die Realität.

[Diese Nachricht wurde von Wolle84 am 24. Nov. 2020 editiert.]

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

---

Servus

Willkommen im Forum.
Ein paar Anmerkungen:

• Dimensionieren von mehreren Variablen in einer Zeile dimensioniert nur die letzte korrekt.
  
• On Error Resume netx sparsam verwenden (deshalb hattest du keine Fehlermeldung bekommen.

Hier mein überarbeiteter Code:

Code:

---

Dim Trikontxtpara(1) as String

Trikontxtpara(0) = "Bla"
Trikontxtpara(1) = "Blub"

Sub CATMain()

Set ActiveDoc = Catia.ActiveDocument

If InStr(ActiveDoc.Name, ".CATPart") <> 0 Then
     
        CreateParameters (ActiveDoc.Product)
 
     
  ElseIf InStr(ActiveDoc.Name, ".CATProduct") <> 0 Then
 
        Dim USel As Object
        Dim Was(1)
        Dim E As String
     
        Was(0) = "Product"
        Was(1) = "Part"
        Set USel = ActiveDoc.Selection
        USel.Clear
        E = USel.SelectElement3(Was, "Ein oder mehrere Produkte/Parts auswählen", False, CATMultiSelTriggWhenUserValidatesSelection, False)
             
        If E = "Normal" Then
          MsgBox "Ausgewaehlte Elemente: " & CStr(USel.Count2), 64, Makroname + " " + version
         
          Dim number, ind As Integer
          Dim Bauteil As Variant
                                 
          number = USel.Count2
         
          For ind = 1 To number
              Set SelElement = USel.Item2(ind).Value
              If TypeName(SelElement) = "Part" then
                    CreateParameters (SelElement.Parent)
                Else
                    CreateParameters (SelElement)
                end if
          Next
         
        Else
            MsgBox "Abbruch"
            Exit Sub
        End If
       
        USel.Clear 
 
    Else
        MsgBox "ungültige Auswahl! Bitte ein Produkt oder Part öffnen", 16, Makroname + " " + version
        Exit Sub

    End If

End Sub

Sub CreateParameters(iProduct As Product)

  Dim userParameters As parameters
  Dim param As Parameter
  Dim sPartNumber As String
  Dim RefProduct As Product
  Dim nbParameters As Integer
  dim ParaNumber As Integer
  dim i As Integer
  dim j As Integer
  Dim lfound As Boolean 
 
  Set RefProduct = iProduct.ReferenceProduct
  Set userParameters = RefProduct.UserRefProperties
  nbParameters = userParameters.Count

  sPartNumber = RefProduct.Name

  ParaNumber = UBound(Trikontxtpara)
 
 
  For i = 0 To ParaNumber

        'paramName = sPartNumber & "\Eigenschaften\" & Trikontxtpara(i)
        paramName = sPartNumber & "\Properties\" & Trikontxtpara(i)

'//---------------------------------------------------------------------------
'// Kontrollieren ob das Attribut bzw. Parameter bereits vorhanden ist
'//---------------------------------------------------------------------------

        lfound = False
     
        For j = 1 To userParameters.Count
            If (userParameters.Item(j).Name = paramName) Then
              lfound = True
            End If
        Next
     
        If (lfound = False) Then
          Set param = userParameters.CreateString(Trikontxtpara(i), "")
        End If
     
    Next
 
End Sub

---

Meine Anpassungen:

• An Unteroutinie eine Product übergeben kein Variant
  
• On Error resume next entfernt
  
• Fallunterscheidung vor Aufruf der Unterroutine ergänzt.

Gruß
Bernd

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

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

---

Danke Bernd für deine schnelle Antwort und den Hinweis mit der Dimensionierung.

habe deinen Code übernommen aber leider bekomme ich bei der Übergabe an die Sub CreateParameters die Fehlermeldung:

Run-Time error '438'
Object doesn't support this property or method

was mir noch aufgefallen ist, egal ob ich ein Part oder ein Product selektiere er geht bei der Abfrage immer in die "Else" Zeile also "CreateParameters (SelElement)"

Ist nur ein einzelnes Part im Aktiven Fenster funktioniert es weiter einwandfrei!

Ich kopiere zur Sicherheit das ich keinen Schreibfehler drin habe nochmal meinen aktualisierten Code:

If InStr(ActiveDoc.Name, ".CATPart") <> 0 Then
     
        CreateParameters (ActiveDoc.Product)
   
       
    ElseIf InStr(ActiveDoc.Name, ".CATProduct") <> 0 Then
   
        Dim USel As Object
        Dim Was(1)
        Dim E As String
       
        Was(0) = "Product"
        Was(1) = "Part"
        Set USel = ActiveDoc.Selection
        USel.Clear
        E = USel.SelectElement3(Was, "Ein oder mehrere Produkte/Parts auswählen", False, CATMultiSelTriggWhenUserValidatesSelection, False)
               
        If E = "Normal" Then
          MsgBox "Ausgewaehlte Elemente: " & CStr(USel.Count2), 64, Makroname + " " + version
         
          Dim number As Integer
          Dim ind As Integer
         
                                   
          number = USel.Count2
         
          For ind = 1 To number
              Set SelElement = USel.Item2(ind).Value
                If TypeName(SelElement) = "Part" Then
                  CreateParameters (SelElement.Parent)
              Else
                  CreateParameters (SelElement)
              End If
          Next
         
        Else
            MsgBox "Abbruch"
            Exit Sub
        End If
        USel.Clear
   
   
    Else
        MsgBox "ungültige Auswahl! Bitte ein Produkt oder Part öffnen", 16, Makroname + " " + version
        Exit Sub

    End If
               
               

       
   

'//---------------------------------------------------------------------------
'// Infobox > Makro fertig
'//---------------------------------------------------------------------------

    Err.Clear

    iErr = Err.number
        If (iErr <> 0) Then
            MsgBox (Err.Description)
            Exit Sub
        End If

    MsgBox "Parameter geschrieben", 64, Makroname + " " + version

End Sub

'//---------------------------------------------------------------------------
'// Parameterwert erstellen
'//---------------------------------------------------------------------------

Sub CreateParameters(iProduct As Product)

  Dim userParameters As parameters
  Dim param As Parameter
  Dim sPartNumber As String
  Dim RefProduct As Product
  Dim nbParameters As Integer
  Dim ParaNumber As Integer
  Dim i As Integer
  Dim j As Integer
  Dim lfound As Boolean
 
  Set RefProduct = iProduct.ReferenceProduct
  Set userParameters = RefProduct.UserRefProperties
  nbParameters = userParameters.Count
  sPartNumber = RefProduct.Name
  ParaNumber = UBound(Trikontxtpara)
 
  For i = 0 To ParaNumber

        paramName = sPartNumber & "\Properties\" & Trikontxtpara(i)

'//---------------------------------------------------------------------------
'// Kontrollieren ob das Attribut bzw. Parameter bereits vorhanden ist
'//---------------------------------------------------------------------------

        lfound = False
       
        For j = 1 To userParameters.Count
            If (userParameters.Item(j).Name = paramName) Then
              lfound = True
            End If
        Next
       
        If (lfound = False) Then
          Set param = userParameters.CreateString(Trikontxtpara(i), "")
        End If
       
    Next
   
End Sub

Eine Frage noch:
wann muss ich eine Variable mit "Dim" vorher festlegen?
in deinem Code wurde z.B. "SelElement" vorher nicht dimensioniert

Viele Grüße Wolfgang

------------------
Die Fantasie ist die einzige Waffe gegen die Realität.

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

---

Servus Wolfgang

Wird das richtige Objekt an die Sub übergeben (TypeName)?
Eventuell beim Aufruf mal die Klammer weglassen.
Oder beim Aufrufe gleich das ReferenceProduct übergeben und nicht die Instance.
In einem ProductDocument können nur Products eingefügt werden, deshalb gibt es in PartDocuments und ProductDocuments ein Product dass dann in die Baugruppe eingehängt wird.

Ich empfehle dir alle Variablen/Objekte du dimensionieren (eventuell in VBA auch Option Explicit aktivieren): macht die Fehlersuche einfacher.

Gruß
Bernd

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

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

---

so jetzt komm ich endlich dazu ne Antwort zu schreiben.

Bernd vielen Dank für deine Hilfe!

man möchte es nicht glauben aber es waren einfach nur die Klammern beim Aufruf 

Bei mir zu Hause funktioniert es jetzt genauso wie es soll!

habe es dann mal mit in die Arbeit genommen und es getestet leider bekomme ich da bei allen DIM ... as Product oder Parameter (alles was mit Catia zu tun hat)

einen Fehler ich denke das liegt an einer nicht geladenen Library oder?
Kennt jemand das Problem?

------------------
Die Fantasie ist die einzige Waffe gegen die Realität.

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

---

Servus

Als was führst du das Makro aus? zB als catvbs sind keine Dimensionierungen zulässig.
In VBA fehlen ggf die entsprechenden Referenzen (in den Optionen?)

Gruß
Bernd

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

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