05-04-2017
01:28 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
05-04-2017
01:28 AM
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
- - - - - - - - - - - - - - -
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