Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
Owner2229
in reply to: L.R20

Hey, how about this? Orange is the only "real" change, the rest is just simplification.

 

 

Sub Main()
    'Check if open document is sheetmetal
    '---------------------------------------------------------------------------------------------
    Dim oDoc As Document = ThisApplication.ActiveDocument
    If oDoc.DocumentSubType.DocumentSubTypeID <> "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then Exit Sub
    
    'Check if open sheetmetal document has flatpattern view
    '---------------------------------------------------------------------------------------------
    Dim oSMD As ComponentDefinition = oDoc.ComponentDefinition
    If Not oSMD.HasFlatPattern Then Exit Sub
    Dim oFlat As FlatPattern = oSMD.FlatPattern
    
    'Check if feature "BendMarkerHoles" exists
    '---------------------------------------------------------------------------------------------
    Dim FeatureName As String = "BendMarkerHoles"
    
    Dim oFTS As FlatPatternFeatures = oFlat.Features
    If oFTS.Count > 0 Then
        For Each oFT As PartFeature In oFTS
            If oFT.Name <> FeatureName Then Continue For
            Try
                oFT.Delete()
            Catch
            End Try
            Exit For
        Next
    End If
    BendMarker(oFlat)
End Sub    
    
Sub BendMarker(oFlat As FlatPattern)
    Dim oEdges As Edges
    Dim oHoleCenters As Object = ThisApplication.TransientObjects.CreateObjectCollection
    
    'Flatpattern sketch -------------------------------------------------------------------------
    Dim oSketch As PlanarSketch = oFlat.Sketches.Add(oFlat.TopFace, False)
    oSketch.Edit()
    
    'Detect bend down ---------------------------------------------------------------------------
    oEdges = oFlat.GetEdgesOfType(64005, True)
    WorkEdges(oHoleCenters, oSketch, oEdges)
    
    'Detect bend up -----------------------------------------------------------------------------
    oEdges = oFlat.GetEdgesOfType(64004, True)
    WorkEdges(oHoleCenters, oSketch, oEdges)
    
    Call oFlat.Features.HoleFeatures.AddDrilledByThroughAllExtent(oHoleCenters, 0.1, kPositiveExtentDirection)
    
    Try
        Dim oHoleFeat As HoleFeature = oFlat.Features.HoleFeatures.Item(1)
        oHoleFeat.Name = "BendMarkerHoles"
    Catch
    End Try
    
    oSketch.ExitEdit()
    oSketch.Name = "MarkedBends"
End Sub

Sub WorkEdges(ByRef oHoleCenters As Object, ByRef oSketch As PlanarSketch, oEdges As Edges)
Dim oTG As TransientGeometry = ThisApplication.TransientGeometry For Each oEdge As Edge In oEdges Dim oEnt As SketchEntity = oSketch.AddByProjectingEntity(oEdge) Dim P As Point2d = oEnt.StartSketchPoint.Geometry Dim oSP As SketchPoint = oSketch.SketchPoints.Add(oTG.CreatePoint2d(P.X, P.Y), True) oHoleCenters.Add (oSP) P = oEnt.EndSketchPoint.Geometry Dim oEP As SketchPoint = oSketch.SketchPoints.Add(oTG.CreatePoint2d(P.X, P.Y), True) oHoleCenters.Add (oEP) Next End Sub

 

Consider using "Accept as Solution" / "Kudos" if you find this helpful.
- - - - - - - - - - - - - - -
Regards,
Mike

"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live." - John F. Woods