Add Node instead of Ellipse

I found this example code here:

https://community.coreldraw.com/sdk/api/draw/23/m/segment.getpeaks

I edited it as follows:

Sub AddNodesAtExtremum()
If ActiveShape Is Nothing Then Exit Sub

Dim s As Shape
Set s = ActiveShape
Test s, 90
Test s, 180
End Sub

Private Sub Test(s As Shape, Angle As Double)
Dim seg As Segment
Dim t1 As Double, t2 As Double, n As Long
For Each seg In s.Curve.Segments
n = seg.getPeaks(Angle, t1, t2)
If n > 1 Then MarkPoint seg, t2, Angle
If n > 0 Then MarkPoint seg, t1, Angle
Next seg
End Sub

Private Sub MarkPoint(seg As Segment, t As Double, Angle As Double)
Dim x As Double, y As Double
Dim dx As Double, dy As Double
Dim s As Shape, a As Double

a = Angle * 3.1415926 / 180
dx = 1.5 * Cos(a)
dy = 1.5 * Sin(a)
seg.GetPointPositionAt x, y, t, cdrParamSegmentOffset
'ActiveLayer.CreateLineSegment x + dx, y + dy, x - dx, y - dy

'create ellipse
Set s = ActiveLayer.CreateEllipse2(x, y, 0.025)
s.fill.UniformColor.RGBAssign 255, 0, 0

End Sub

Instead of creating an ellipse how do I add node at that point?

Thanks.

Parents
  • Moiz, 

    Adding a node is going to add segments. So I would make a PointRange for where you want to add the nodes then add them. I have cleaned up the code a bit also.

    Sub AddNodesAtExtremum()
        Dim s As Shape, seg As Segment, ofs As Double
        Dim pr As New PointRange, p As Point
        
        If ActiveShape Is Nothing Then Exit Sub
        
        Set s = ActiveShape
        Test s, 90, pr
        Test s, 180, pr
        
        For Each p In pr
            Set seg = s.Curve.FindSegmentAtPoint(p.x, p.y, ofs)
            seg.AddNodeAt ofs, cdrParamSegmentOffset
        Next p
    End Sub
    
    Private Sub Test(s As Shape, Angle As Double, pr As PointRange)
        Dim seg As Segment
        Dim t1 As Double, t2 As Double, n As Long
    
        For Each seg In s.Curve.Segments
            n = seg.GetPeaks(Angle, t1, t2)
            If n > 1 Then MarkPoint seg, t2, pr
            If n > 0 Then MarkPoint seg, t1, pr
        Next seg
    End Sub
    
    Private Sub MarkPoint(seg As Segment, t As Double, pr As PointRange)
        Dim x As Double, y As Double
    
        seg.GetPointPositionAt x, y, t, cdrParamSegmentOffset
        pr.AddPointXY x, y
    End Sub
    

    Happy coding,

    -Shelby

Reply Children