---

1.jpg 2.jpg

Hallo,
in meiner Firma haben wir in unserem StartPart eine BoundingBox, um die Fertigmaße zu ermitteln
und an die Stücklistenparameter weiterzugeben. Bei Kantteilen haben wir die Abwicklung bisher
manuell konstruiert und die berechneten Maße (über Laws usw.) an die Stücklistenparameter
weitergegeben. Jetzt haben wir inzwischen einen SheetMetal-Lizenz und das StartPart soll entsprechend umgebaut werden.
Bei Kantteilen soll nun der Body mit dem Kantteil ("Rohteil") kopiert und als Abwicklung eingefügt werden.
Anschließend soll die BoundingBox auf die Abwicklung referenziert werden. Manuell ist das kein
Problem. Ich möchte das allerdings gerne als VB-Reaction realisieren. Nun stehe ich vor zwei
Problemen, zu denen ich bisher nichts gefunden habe:
1) Wie ändere ich das Referenzelement des Extract der BoundingBox? Das Extract bezieht
   sich auf den Body “Fertigteil“ und soll bei Kantteilen auf den Body “Abwicklung“ referenziert werden.
2) Wie führe ich “Paste Special As Result With Link Flat mode“ aus?

Zu den Abbildungen:
1) Strukturbaum vor der Abwicklung
2) Strukturbaum mit der Abwicklung

Hier die aktuelle Reaction:

Code:

---

Sub CATMain()
'On error resume next
'   Err.Clear
      Set oSel = CATIA.ActiveDocument.Selection
      If (oSel.Count = 1) Then
         If (TypeName(oSel.Item(1).Value) = "StrParam") Then
            Set oPart = oSel.Item(1).Value.Parent.Parent
         End If
      End If
      Set oPara = oPart.Parameters
      Set oBodyFertigteil = oPart.Bodies.Item("Fertigteil")
      Set oBodyRohteil = oPart.Bodies.Item("Rohteil")
      Set strBauteilart = oPara.Item("Bauteilart")
      Set strBauteilform = oPara.Item("Bauteilform")

      If strBauteilart.Value = "Pad" And strBauteilform.Value = "Gebogen" Then
      ' Extract auf den Body "Fertigteil" referenziert
     
      ' Body "Rohteil" kopieren und mit Link und Unfold einfügen und in "Abwicklung" umbenennen
         oSel.Add oBodyRohteil
         oSel.Copy
         oSel.Clear
         oSel.Add oPart
         oSel.PasteSpecial "CATPrtResult"
         oSel.Clear
         oPart.Bodies.Item(oPart.Bodies.Count).Name = "Abwicklung"
      ' Assembly von Body "Abwicklung" mit Body "Fertigteil"
         oPart.InWorkObject = oBodyFertigteil
         Set oShapeFactory = oPart.ShapeFactory
         Set oBodyAbwicklung = oPart.Bodies.Item("Abwicklung")
         Set oAssembly = oShapeFactory.AddNewAssemble(oBodyAbwicklung)
      ' Assembly in "Abwicklung" umbenennen
         Set oShapes = oBodyFertigteil.Shapes
            oShapes.Item(oShapes.Count).Name = "Abwicklung"
      ' Extract auf den Body "Abwicklung" referenzieren
        
      Else
      ' Extract auf den Body "Fertigteil" referenziert
     
      ' Body "Abwicklung" löschen
         Set oBodyAbwicklung = oPart.Bodies.Item("Abwicklung")
            oSel.Add oBodyAbwicklung
            oSel.Delete
            oSel.Clear
      End If

'   If Err.Number <> 0 Then
'      MsgBox "Unbekannter Fehler" & vbLf & _
'         "------------------------------------------------------------------" & vbLf & _
'         "Beenden Sie das Makro mit Cancel.", vbExclamation, "Warning"
'   End If
'On Error GoTo 0
End Sub

---

[Diese Nachricht wurde von InFlames am 11. Mrz. 2018 editiert.]

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