Help! Why ShapeRange.Group returns "Nothing"?

Navi1982 over 8 years ago

Hi everybody!

I trying to script a macro that will draw lines in place of controlpoints arrows (of Bezier curves). My problem is (see row 37): Why ShapeRange.Group returns "Nothing"? But in other subroutine it working fine... Please help me - where is my error?

Generally I want to draw lines at selected nodes if it was selected... In other case - it must draw lines at starting and ending nodes of each subpaths of selected shapes. After all drawns - lines must be grouped and remain selected.

This is how I try to do it:

Sub DrwCtrlPntLines()
'Draw lines in place of controlpoints arrows
Dim OSel As ShapeRange
Dim sr As ShapeRange
Dim s As Shape
Dim nr As New NodeRange
Dim n As node
Dim sp As SubPath
Dim crv As Curve
Set OSel = ActiveSelectionRange
'collect selected nodes
For Each s In OSel
If (s.Type = cdrCurveShape) And (s.Curve.Selection.Count > 0) Then nr.AddRange s.Curve.Selection
Next
'if nodes not selected - set begining and ending nodes
If nr.Count = 0 Then
For Each s In OSel 'look in each shapes
If s.Type = cdrCurveShape Then 'of curve
For Each sp In s.Curve.SubPaths 'in it's each subpath
nr.Add sp.StartNode 'for one of the ending nodes
nr.Add sp.EndNode 'and collect it
Next sp
End If
Next s
End If
'draw control point lines at collected nodes
Set sr = New ShapeRange
sr.RemoveAll
For Each n In nr
Set s = ActiveLayer.CreateCurveSegment(n.PositionX, n.PositionY, _
n.Segment.EndingControlPointX, n.Segment.EndingControlPointY)
sr.Add s
Next n
Dim sg As Shape
Set sg = sr.Group 'sg becomes Nothing when nodes was selected
If Not sg Is Nothing Then sg.CreateSelection
End Sub

Having looked through the help, I found that NodeRange can collect nodes only from a single curve. Also, I discovered that if we'll trying to group something, when ShapeTool (cdrToolNodeEdit) is active - ShapeRanges will be grouped, but as result always will return Nothing. So, before to group ShapeRanges, always you must switch to "Pick Tool" (cdrToolPick). And, if we made some selection with ShapeTool - we need also to clear all selections, before switching to Pick Tool. So, I rewrote my code. And it work fine! Look my post below.

Parents

0 Navi1982 over 8 years ago
Sub DrawControlPointLines()

'by Vanea

'Draw lines in place of controlpoints arrows at selected nodes,

' or at starting and ending nodes of selected curve shapes.

Dim OSel As ShapeRange

Dim sr As New ShapeRange

Dim s As Shape

Dim NSel As Long      'Nodes Selected

Dim n As node

Dim sp As SubPath

Set OSel = ActiveSelectionRange

'draw lines at selected nodes

NSel = 0

For Each s In OSel

    If s.Type = cdrCurveShape Then NSel = NSel + s.Curve.Selection.Count

   'draw control point lines at selected nodes

    If s.Curve.Selection.Count > 0 Then

      For Each n In s.Curve.Selection

       'If node is ending one

        If n.IsEnding Then

         ' and if it is at first segment -> draw only one line

          If n.PrevSegment Is Nothing Then _

            sr.Add ActiveLayer.CreateLineSegment(n.PositionX, _

                                                 n.PositionY, _

                                                 n.NextSegment.StartingControlPointX, _

                                                 n.NextSegment.StartingControlPointY)

         ' or if it is at last segment -> draw only one line

          If n.NextSegment Is Nothing Then _

            sr.Add ActiveLayer.CreateLineSegment(n.PositionX, _

                                                 n.PositionY, _

                                                 n.Segment.EndingControlPointX, _

                                                 n.Segment.EndingControlPointY)

        Else

         'in case node is inside of subpath or on closed subpath -> draw lines in both sides

            sr.Add ActiveLayer.CreateLineSegment(n.PositionX, _

                                                 n.PositionY, _

                                                 n.Segment.EndingControlPointX, _

                                                 n.Segment.EndingControlPointY)

            sr.Add ActiveLayer.CreateLineSegment(n.PositionX, _

                                                 n.PositionY, _

                                                 n.Segment.Next.StartingControlPointX, _

                                                 n.Segment.Next.StartingControlPointY)

        End If

      Next n

    End If

Next s

'if nodes not selected - draw lines at begining and ending nodes of each subpaths of selected curves

If NSel = 0 Then

    For Each s In OSel                      'look in each shapes

      If s.Type = cdrCurveShape Then        'of curve

        For Each sp In s.Curve.SubPaths     'in it's each subpath

        'draw control point lines at first segment and starting node

          sr.Add ActiveLayer.CreateLineSegment(sp.FirstSegment.StartNode.PositionX, _

                                               sp.FirstSegment.StartNode.PositionY, _

                                               sp.FirstSegment.StartingControlPointX, _

                                               sp.FirstSegment.StartingControlPointY)

        'draw control point lines at last segment and ending node

          sr.Add ActiveLayer.CreateLineSegment(sp.LastSegment.EndNode.PositionX, _

                                               sp.LastSegment.EndNode.PositionY, _

                                               sp.LastSegment.EndingControlPointX, _

                                               sp.LastSegment.EndingControlPointY)

        Next sp

      End If

    Next s

    sr.Group.CreateSelection    'group and select lines drawn from starting and ending nodes of each subpaths of each selected shapes

Else

   'group and select lines drawn from selected nodes

    ActiveDocument.ClearSelection

    ActiveTool = cdrToolPick

    sr.Group.CreateSelection

End If

End Sub
Cancel
Up 0 Down

Reply

Reject Answer

Cancel

Reply

0 Shelby Moore over 8 years ago in reply to Navi1982

Here is my version. Very similar but I thought I would post as another example.

Sub DrawControlPointLines()
    Dim s As Shape
    Dim sr As ShapeRange, srControls As New ShapeRange
    Dim n As Node, sPath As SubPath
    Dim nodeX As Double, nodeY As Double
    Dim controlX As Double, controlY As Double

    Set sr = ActiveSelectionRange
    
    On Error GoTo ErrHandler
    Optimization = True
    ActiveDocument.BeginCommandGroup "Draw Control-Point Lines"
    EventsEnabled = False
    ActiveDocument.SaveSettings
    ActiveDocument.PreserveSelection = False
    
        For Each s In sr.Shapes
            If s.Type = cdrCurveShape Then
                If s.Curve.Selection.Count = 0 Then
                    For Each sPath In s.Curve.SubPaths
                        sPath.Nodes.First.Selected = True
                    Next sPath
                End If
                
                For Each n In s.Curve.Selection
                    nodeX = n.PositionX
                    nodeY = n.PositionY
                    
                    If Not n.PrevSegment Is Nothing Then
                        If n.PrevSegment.Type = cdrCurveSegment Then
                            controlX = n.PrevSegment.EndingControlPointX
                            controlY = n.PrevSegment.EndingControlPointY
                            srControls.Add ActiveLayer.CreateLineSegment(nodeX, nodeY, controlX, controlY)
                        End If
                    End If
                    
                    If Not n.NextSegment Is Nothing Then
                        If n.NextSegment.Type = cdrCurveSegment Then
                            controlX = n.NextSegment.StartingControlPointX
                            controlY = n.NextSegment.StartingControlPointY
                            srControls.Add ActiveLayer.CreateLineSegment(nodeX, nodeY, controlX, controlY)
                        End If
                    End If
                Next n
            End If
        Next s
    
        srControls.SetOutlineProperties Width:=0.028, Color:=CreateCMYKColor(0, 100, 100, 0), EndArrow:=ArrowHeads(2)
        srControls.CreateSelection
        srControls.Group.CreateSelection
    
ExitSub:
    ActiveDocument.PreserveSelection = True
    ActiveDocument.RestoreSettings
    EventsEnabled = True
    Optimization = False
    ActiveWindow.Refresh
    Application.Refresh
    ActiveDocument.EndCommandGroup
    Exit Sub

ErrHandler:
    MsgBox "Error occured: " & Err.Description
    Resume ExitSub
End Sub

Happy Coding,

-Shelby

Children

No Data