Breaking line style apart

[vindaa]

Hi is their a way to break a line style apart. I mean breaking apart all the dash dots in a line as separate objects.

I need this because when I change the line weight the spacing between the dashes changes

Please help

[shelbym]

Basically you just need to convert the line to objects, then break the objects apart:

Sub BreakLineStyle()
    Dim s As Shape
    
    Set s = ActiveShape
    Set s = s.Outline.ConvertToObject
    s.BreakApart
End Sub

Best of luck,

-Shelby

[runflacruiser]

Hi.
Just to add to Shelby's answer you can also use BreakApartEx which returns a ShapeRange. You can Set your object reference inline like this:

Dim sr as ShapeRange

Set sr = s.BreakApartEx

Just in case you need to work with the dashes later...

~John

[vindaa]

Hey thanks for the quick reply, But this is not what I want.
I dont want them to turn into boxes I want them to stay as just plain simple lines. (So that I can reduce the line thickness and still the length of the dashes remain same)

[vindaa]

I mean I want it to be broken apart as small lines and not rectangular objects, Is it possible

[Joe]

This is not really an elegant solution, it gets you fairly close, though. I had a need for a similar thing to simulate some stitching and wanted it to be nice and even (to the eye anyways).

So, say, we have a shape:


What we do is "equalize" the nodes using this code:

Sub EqualizeNodes()
    
    Dim Seg As Segment
    
    Dim L As Double
    
    Dim S As Shape
    
    Set S = ActiveSelection.Shapes.First
    
    L = S.Curve.Segments.First.Length
    
    For Each Seg In S.Curve.Segments
        If Seg.Length < L Then L = Seg.Length
    Next Seg
    
    Dim Reps As Integer
    
    Reps = 1
    
    Do While Reps > 0
        Reps = 0
        For Each Seg In S.Curve.Segments
            If Seg.Length > L Then
                Seg.AddNodeAt
                Reps = Reps + 1
            End If
        Next Seg
    Loop
End Sub

It takes the smallest segment length (try not to have really tiny ones in there or it will take forever) and tries to make all segments as close to that as it can:


After which you just run a code that draws in every second segment with a line:

Sub Lines()
    Dim I As Integer
    
    Dim S As Shape
    
    Set S = ActiveSelection.Shapes.First
    
    For I = 1 To S.Curve.Nodes.Count - 1 Step 2
        With S.Curve.Nodes
            ActiveLayer.CreateLineSegment .Item(I).PositionX, .Item(I).PositionY, .Item(I + 1).PositionX, .Item(I + 1).PositionY
            
        End With
    Next I
End Sub

After which we get something like this:


The result depends quite a bit on your initial shape and segments, but it's reasonably easy to tweak and you get neat lines. A downside is that the lines are straight (something that could be overcome by copying out segments instead of drawing to their coordinates I suppose). Anyhow, hope this helps a bit.

[vindaa]

Hi Thanks for the work around,
But the only problem is the spacing between the dashes are uneven depending on the length of each line segment.
??? is their a better way ???

[shelbym]

This one really made me think, but I think I have a better way. Basically, I make a copy of the line, then convert the original outline to curves, then create an intersection of the two. Copy the outline thickness and color to the new intersection and delete the original. Here is the code:

Sub KeepDashes()
    Dim sOriginal As Shape, sDup As Shape, sNewLine As Shape
    Dim dblOutlineWidth As Double
    Dim colOutline As New Color

    Set sOriginal = ActiveShape 'Get the selected shape
    
    dblOutlineWidth = sOriginal.Outline.Width 'Copy the line thickness
    colOutline.CopyAssign sOriginal.Outline.Color 'Copy the line color
    
    Set sDup = sOriginal.Duplicate 'Create a duplicate of the original
    
    sDup.Outline.SetNoOutline 'Remove the outline
    If sDup.Type <> cdrCurveShape Then sDup.ConvertToCurves
    If sDup.Curve.Closed Then sDup.Curve.Nodes.First.BreakApart

    Set sOriginal = sOriginal.Outline.ConvertToObject 'Convert the orginal outline to a curve
    Set sNewLine = sOriginal.Intersect(sDup)

    sNewLine.Outline.Width = dblOutlineWidth 'Apply the saved width
    sNewLine.Outline.Color.CopyAssign colOutline 'Apply the saved color
    
    'Clean up
    sOriginal.Delete
    sDup.Delete
    Set sNewLine = Nothing
End Sub

Hopefully it truly is a better way. :-)

-Shelby

[vindaa]

Hey, you are genius, that was a wonderful way going about it.
For me it works like a charm

Thanks a Lot

[Joe]

That is a neat solution, Shelby. The reason I was looking into "equalizing" nodes was that usually the gaps aren't the same width near the ends when dealing with a dashed line (and since this solution was meant for simulating stitches that wasn't too good).

Ironically the previous workaround didn't quite accomplish this either, but here comes an improved version:

Sub EqualizeNodes()
    
    Dim Steps As Integer
    Dim Seg As Segment
    Dim L As Double, GL As Double, Bit As Double
    
    ActiveDocument.Unit = cdrMillimeter
    Bit = 5
    
    Dim S As Shape
    
    Set S = ActiveSelection.Shapes.First
    
    GL = S.Curve.Length
    
    Steps = GL / Bit
    
    L = GL / Steps
    
    Dim Reps As Integer
    
    'boostStart "Equalize Nodes"
    
    Do While Reps < Steps - 1
        
        If Reps + 1 > S.Curve.Segments.Count Then Exit Do
        
        With S.Curve.Segments(Reps + 1)
            If .Length > L Then
                .AddNodeAt L / .Length
                Reps = Reps + 1
            Else
                .EndNode.Delete
            End If
        End With
    Loop
    
    'boostFinish True
End Sub

You can set the "Bit" which is desired gap between nodes and the macro will try to get as close to that as possible. This is dependent on Corel's curve length function which technically cannot be perfect so the result may not be perfect on the first go. But if you run it several times on the same curve it evens out nicely.

So you take this:

And can get this:


The code is rather rough as most of my work, but should work well enough. Improvements welcome.