---

Hallo allerseits,

Seit wenigen Tagen beschäftige ich mich nun mit Makro programmieren in VBA und hab da jetzt mal eine Frage 
Ich habe mit viel Mühe ein Makro geschrieben, welches in einem Part automatisch Paramter mit Werten hinzufügt (die benötige ich später zum auslesen)und gleichzeitig den Konstruktionskörper (wenn dieser nicht der Hauptkörper ist) in den MainBody einfügt.

Mein Problem: Bis jetzt funktioniert das ganze in einem Part recht gut, jedoch soll es in einem Produkt ebenso funktioniern.
Es gäbe die Möglichkeit in dem Produkt jedes Part einzeln zu öffnen und dann anzugleichen, aber das ist sehr viel Aufwand und wenn man ein großes Bauteil hat sitzt man da mal ne Weile dran. Deshalb die Suche nach der Vereinfachung.
Ich habe leider keine Ahnung wie ich das ganze Anpacken soll  Ich bin für jede Hilfe dankbar 
Mein bisherigen Code stelle ich mal dazu =)

Sub CATMain()

'Variablen definieren
    Dim InputObjectType(0)
    Dim newMass
 
Dichte = "7860"
         
'Prüfen ob aktives Dokument ein Part ist
    Set activedoc = CATIA.ActiveDocument
    If Err.Number <> 0 Then
        MsgBox " Es ist kein Teil geöffnet"
        Exit Sub
    End If
   
   

'******************************Referenz vom Hauptkörper erstelllen und Volumen messen ******************************************************
    Set oReference = activedoc.Part.CreateReferenceFromObject(activedoc.Part.MainBody)
    Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
    Set TheMeasurable = TheSPAWorkbench.GetMeasurable(oReference)

    On Error Resume Next
        dVolume = TheMeasurable.Volume
        If Err.Number = 0 Then
    On Error GoTo 0
        End If
        If Err.Number <> 0 Then
    On Error GoTo 0
        MsgBox "Hauptkörper ist leer, bitte anderen Körper wählen"
          Set selection1 = activedoc.Selection
          InputObjectType(0) = "Body"
          Status = selection1.SelectElement2(InputObjectType, "Wähle einen Körper", False)
          If (Status = "Cancel") Then
              MsgBox " Makro wurde abgebrochen"
              Exit Sub
          Else
              Set usersel = selection1.Item(1).Value
          End If
         
          Set oReference = activedoc.Part.CreateReferenceFromObject(usersel)
          Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
          Set TheMeasurable = TheSPAWorkbench.GetMeasurable(oReference)
       
          dVolume = TheMeasurable.Volume

'*****************************Addition der Körper****************************************************************************
           
            Set APart = CATIA.ActiveDocument.Part
            Set Wzk3D = APart.ShapeFactory

            Set MainBody = APart.Bodies.Item(1)
            Set Body2 = APart.Bodies.Item(2)
   
            APart.InWorkObject = MainBody
            Set Operation = Wzk3D.AddNewAdd(Body2)

            APart.Update
        End If

Dim Fertigteilgewicht As String
Fertigteilgewicht = Round(dVolume * Dichte, 1) & "kg"

'******************************************ParameterDokumentenname**************************************************************************

Name = CATIA.ActiveDocument.Name

NameUebernehmen = Mid(Name, 11, InStrRev(Name, ".") - 11)
Positionsnummer = Mid(Name, 6, 4)

On Error Resume Next
    Set ParameterNamen = CATIA.ActiveDocument.Part.Parameters.Item("Bauteilname")
If Err.Number <> 0 Then
    Set ParameterNamen = CATIA.ActiveDocument.Part.Parameters.CreateString("Bauteilname", NameUebernehmen)
End If
On Error GoTo 0

On Error Resume Next
    Set ParameterPositionsnummer = CATIA.ActiveDocument.Part.Parameters.Item("Pos")
If Err.Number <> 0 Then
    Set ParameterPositionsnummer = CATIA.ActiveDocument.Part.Parameters.CreateString("Pos", Positionsnummer)
End If
On Error GoTo 0

'************************************Parameter erzeugen*******************************************************************



'Dim ParameterMasseErstellen As Parameters
Dim strParameter As StrParam 'Hier den Typ deklarieren
'Abfrage ob Parameter bereits vorhanden sind, wenn nicht erstellen
On Error Resume Next
        Set strParameter = CATIA.ActiveDocument.Part.Parameters.Item("Fertigteilgewicht")
    If Err.Number <> 0 Then
        Set strParameter = CATIA.ActiveDocument.Part.Parameters.CreateString("Fertigteilgewicht", Fertigteilgewicht)
    End If
On Error GoTo 0

Dim WerkstoffEingabe As String
Dim strWerkstoff As StrParam

On Error Resume Next
    Set strWerkstoff = CATIA.ActiveDocument.Part.Parameters.Item("Werkstoff")
    If Err.Number <> 0 Then
        WerkstoffEingabe = InputBox("Bitte Werstoff eingeben", "Werkstoff auswählen", "1.2343")
        'Falls man abbrechen will
    If WerkstoffEingabe = "" Then
        Box = MsgBox("Das Makro wird beendet!", vbInformation, "Hinweis")
        Exit Sub
  End If
        On Error GoTo 0
        Set strWerkstoff = CATIA.ActiveDocument.Part.Parameters.CreateString("Werkstoff", WerkstoffEingabe)
    End If
On Error GoTo 0

If CATIA.ActiveDocument.Part.Parameters.Item("Werkstoff").Value = "" Then

    MsgBox "Material fehlt, bitte eingeben"
   
        WerkstoffEingabe = InputBox("Bitte Werstoff eingeben", "Werkstoff auswählen", "1.2343")
      'Falls man abbrechen will
    If WerkstoffEingabe = "" Then
        Box = MsgBox("Das Makro wird beendet!", vbInformation, "Hinweis")
        Exit Sub
  End If
        On Error GoTo 0
    CATIA.ActiveDocument.Part.Parameters.Item("Werkstoff").Value = WerkstoffEingabe
End If
     

Dim HaerteEingabe As String
Dim strHaertung As StrParam

On Error Resume Next
        Set strHaerte = CATIA.ActiveDocument.Part.Parameters.Item("Haerte")
    If Err.Number <> 0 Then
        HaerteEingabe = InputBox("Bitte Härte eingeben", "Härte auswählen", "gehärtet 45-47 HRC")
        'Falls man abbrechen will
    If HaerteEingabe = "" Then
        Box = MsgBox("Das Makro wird beendet!", vbInformation, "Hinweis")
        Exit Sub
    End If
        On Error GoTo 0
        Set strHaerte = CATIA.ActiveDocument.Part.Parameters.CreateString("Haerte", HaerteEingabe)
    End If
On Error GoTo 0

If CATIA.ActiveDocument.Part.Parameters.Item("Haerte").Value = "" Then

    MsgBox "Härte fehlt, bitte eingeben"
   
        HaerteEingabe = InputBox("Bitte Härte eingeben", "Härte auswählen", "gehärtet 45-47 HRC")
      'Falls man abbrechen will
    If HaerteEingabe = "" Then
        Box = MsgBox("Das Makro wird beendet!", vbInformation, "Hinweis")
        Exit Sub
  End If
        On Error GoTo 0
    CATIA.ActiveDocument.Part.Parameters.Item("Haerte").Value = HaerteEingabe
End If

Dim BeschichtungEingabe As String
Dim strBeschichtung As StrParam

On Error Resume Next
        Set strBeschichtung = CATIA.ActiveDocument.Part.Parameters.Item("Beschichtung")
    If Err.Number <> 0 Then
        BeschichtungEingabe = InputBox("Bitte Beschichtung eingeben", "Beschichtung auswählen", "nitriert")
        'Falls man abbrechen will
    If BeschichtungEingabe = "" Then
        Box = MsgBox("Das Makro wird beendet!", vbInformation, "Hinweis")
        Exit Sub
    End If
        On Error GoTo 0
        Set strBeschichtung = CATIA.ActiveDocument.Part.Parameters.CreateString("Beschichtung", BeschichtungEingabe)
    End If
On Error GoTo 0

If CATIA.ActiveDocument.Part.Parameters.Item("Beschichtung").Value = "" Then

    MsgBox "Beschichtung fehlt, bitte eingeben"
   
        BeschichtungEingabe = InputBox("Bitte Beschichtung eingeben", "Beschichtung auswählen", "nitriert")
      'Falls man abbrechen will
    If BeschichtungEingabe = "" Then
        Box = MsgBox("Das Makro wird beendet!", vbInformation, "Hinweis")
        Exit Sub
  End If
        On Error GoTo 0
    CATIA.ActiveDocument.Part.Parameters.Item("Beschichtung").Value = BeschichtungEingabe
End If

End Sub
     

Gruß Timothy

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