---

Eine Frage an die Fachleute:
Besteht die Möglichkeit bei Inventor 2025 Kantmarkierungen automatisch auf das das Blechteil aufzubringen?
Ziel ist, dass ich auf dem Blechteil welches gelasert werden soll eine ca. 20 mm Gravur vorhanden ist an der sich der Kanter orientieren kann.

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

---

Moin,

ja, Inventor kann die Biegelinien für die Arbeit an der Gesenkbiegepresse ausgeben (in der Abwicklungsansicht der IDW) und nein: Nicht so wie zB SPI Blech als verkürzte Markierung mit etwas Randabstand zur Schnittkontur.

Das bedarf beides etwas Nacharbeit (zB. mit ACAD).

------------------
Mit besten Grüssen

Andreas Gawin

www.cad-service-gawin.de

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

---

[i][/i]Danke, für deine Nachricht. Soweit war ich leider auch schon. Hatte gehofft, dass es da eine einfache Lösung gibt.

Gruss Jörg

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

---

Moin

Magst du mal das Makro probieren? Es erzeugt in der Abwicklung ein Skizze mit kurzen Linien am Ende der Biegungen. Die Modellskizze in der Zeichnung abrufen, um sie sichtbar zu machen. Es ist keine perfekte Lösung, aber vielleicht so 93%.

Code:

---

Option Explicit

Public Sub Kantmarkierung()

'Offset der Markierlinien vom Biegungsende in cm
Dim dOffSet As Double
dOffSet = 0.5

' Länge Markierung in cm
Dim dMarkLength As Double
dMarkLength = 2

Dim oApp As Inventor.Application
Set oApp = ThisApplication

If Not oApp.ActiveDocumentType = kPartDocumentObject Then
    Exit Sub
End If

Dim oDoc As PartDocument
Set oDoc = oApp.ActiveDocument

If Not oDoc.ComponentDefinition.Type = kSheetMetalComponentDefinitionObject Then
    Exit Sub
End If

Dim oSMCompDef As SheetMetalComponentDefinition
Set oSMCompDef = oDoc.ComponentDefinition

If oSMCompDef.HasFlatPattern = False Then
    oSMCompDef.Unfold
End If

Dim oFP As FlatPattern
Set oFP = oSMCompDef.FlatPattern

Dim oFace As Face
Set oFace = oFP.TopFace

Dim oSketch As PlanarSketch
For Each oSketch In oFP.Sketches
    If oSketch.Name = "Kantmarkierung" Then
        oSketch.Delete
        Exit For
    End If
Next

Set oSketch = oFP.Sketches.Add(oFace)
oSketch.Name = "Kantmarkierung"

Call oSketch.Edit

Dim oSketchEnt As SketchEntity
On Error Resume Next
For Each oSketchEnt In oSketch.SketchEntities
    oSketchEnt.Delete
Next
On Error GoTo 0

Dim oBendResult As FlatBendResult
For Each oBendResult In oFP.FlatBendResults
    If oBendResult.IsOnBottomFace = False Then
        Dim oEdge As Edge
        Set oEdge = oBendResult.Edge
       
        Dim oPoint1 As Point
        Set oPoint1 = oEdge.StartVertex.Point
       
        Dim oPoint2 As Point
        Set oPoint2 = oEdge.StopVertex.Point
       
        Dim oDist As Double
        oDist = oPoint1.DistanceTo(oPoint2)
       
        If oPoint1.DistanceTo(oPoint2) < 3 * dOffSet + 2 * dMarkLength Then ' Mindestlänge der Biegekante
            Call MsgBox("Biegekante zu kurz (<" & 3 * dOffSet + 2 * dMarkLength & "cm). Keine Kantmarkierung möglich. Fahre mit nächster Biegung fort.", vbInformation, "Biegemarker")
            GoTo NextItem
        End If
       
        Dim oSKPoint1 As Point2d
        Set oSKPoint1 = oSketch.ModelToSketchSpace(oPoint1)
       
        Dim oSKPoint2 As Point2d
        Set oSKPoint2 = oSketch.ModelToSketchSpace(oPoint2)
       
        Dim oDirVector1 As Vector2d
        Set oDirVector1 = oSKPoint1.VectorTo(oSKPoint2)
       
        Dim oDirVector2 As Vector2d
        Set oDirVector2 = oSKPoint2.VectorTo(oSKPoint1)
       
        Dim oUnitVector1 As Vector2d
        Set oUnitVector1 = oDirVector1.AsUnitVector.AsVector
       
        Dim oUnitVector2 As Vector2d
        Set oUnitVector2 = oDirVector2.AsUnitVector.AsVector
       
        Call oUnitVector1.ScaleBy(dOffSet)
        Call oUnitVector2.ScaleBy(dOffSet)
       
        Call oSKPoint1.TranslateBy(oUnitVector1)
        Call oSKPoint2.TranslateBy(oUnitVector2)
       
        Set oUnitVector1 = oDirVector1.AsUnitVector.AsVector
        Set oUnitVector2 = oDirVector2.AsUnitVector.AsVector
       
        Call oUnitVector1.ScaleBy(dMarkLength)
        Call oUnitVector2.ScaleBy(dMarkLength)
       
        Dim oSKPoint11 As Point2d
        Set oSKPoint11 = oSKPoint1.Copy
        Call oSKPoint11.TranslateBy(oUnitVector1)
       
        Dim oSKPoint22 As Point2d
        Set oSKPoint22 = oSKPoint2.Copy
        Call oSKPoint22.TranslateBy(oUnitVector2)
       
        Dim oColor As Color
        Set oColor = oApp.TransientObjects.CreateColor(255, 0, 0) ' Farbe als RGB-Code
       
        Dim oLine As SketchLine
        Set oLine = oSketch.SketchLines.AddByTwoPoints(oSKPoint1, oSKPoint11)
        oLine.OverrideColor = oColor
       
        Set oLine = oSketch.SketchLines.AddByTwoPoints(oSKPoint2, oSKPoint22)
        oLine.OverrideColor = oColor
    End If
NextItem:
Next

Call oSketch.ExitEdit

End Sub

---

------------------
MfG
Ralf

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