Add Node instead of Ellipse

Moiz over 1 year ago

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.

Top Replies

Shelby Moore over 1 year ago

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

Moiz over 1 year ago in reply to Shelby Moore

Thank you very much for the code.

Works perfectly the first time.

But on subsequent runs it adds nodes on top of each other.

Please suggest a solution. Thanks.

Wish CorelDRAW included this feature natively.
Cancel
Up 0 Down

Reply

Cancel

Shelby Moore over 1 year ago in reply to Moiz

Just add a check to see if there is all ready a node in that position.

Sub AddNodesAtExtremum()
    Dim s As Shape, seg As Segment, ofs As Double
    Dim pr As New PointRange, p As Point, n As Node
    
    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)
        Set n = s.Curve.FindNodeAtPoint(p.x, p.y)
        If n Is Nothing Then
            seg.AddNodeAt ofs, cdrParamSegmentOffset
        End If
    Next p
End Sub

-Shelby

Moiz over 1 year ago in reply to Shelby Moore

Thanks again for the code.
Cancel
Up +1 Down

Reply

Cancel