View Single Post
  #1  
Old 25-09-2017, 13:32
mtracy mtracy is offline
Member
 
Join Date: Jun 2012
Location: Niceville, Florida
Posts: 31
Default Add nodes at intersects

Select two shapes. Tested with X7.

Sub NodesToIntesects()
Dim s As Shape
Dim nr As New NodeRange
Dim cps As CrossPoints
Dim cp As CrossPoint
ActiveDocument.BeginCommandGroup "NodesToIntersects"
Set s = ActiveSelectionRange.Combine
Set cps = s.Curve.SubPaths(1).GetIntersections(s.Curve.SubPaths(2), cdrAbsoluteSegmentOffset)
For Each cp In cps
nr.Add s.Curve.SubPaths(1).AddNodeAt(cp.Offset, cdrAbsoluteSegmentOffset)
nr.Add s.Curve.SubPaths(2).AddNodeAt(cp.Offset2, cdrAbsoluteSegmentOffset)
Next cp
s.BreakApart
ActiveTool = cdrToolPick
ActiveSelectionRange.RemoveFromSelection
ActiveDocument.EndCommandGroup

End Sub
__________________
Myron Tracy
Accent Signs
Reply With Quote