OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 15-10-2012, 22:38
vindaa vindaa is offline
Member
 
Join Date: Aug 2006
Posts: 91
Default Breaking line style apart

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
Attached Images
 
Reply With Quote
  #2  
Old 15-10-2012, 23:58
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default BeakLineStyle

Basically you just need to convert the line to objects, then break the objects apart:
Code:
Sub BreakLineStyle()
    Dim s As Shape
    
    Set s = ActiveShape
    Set s = s.Outline.ConvertToObject
    s.BreakApart
End Sub
Best of luck,

-Shelby
Reply With Quote
  #3  
Old 16-10-2012, 12:02
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

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
Reply With Quote
  #4  
Old 16-10-2012, 23:32
vindaa vindaa is offline
Member
 
Join Date: Aug 2006
Posts: 91
Default

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)
Reply With Quote
  #5  
Old 16-10-2012, 23:36
vindaa vindaa is offline
Member
 
Join Date: Aug 2006
Posts: 91
Default

I mean I want it to be broken apart as small lines and not rectangular objects, Is it possible
Reply With Quote
  #6  
Old 17-10-2012, 05:13
Joe Joe is offline
Member
 
Join Date: Nov 2008
Location: Latvia
Posts: 92
Send a message via Skype™ to Joe
Wink

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:
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:

Code:
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.
Reply With Quote
  #7  
Old 20-10-2012, 04:56
vindaa vindaa is offline
Member
 
Join Date: Aug 2006
Posts: 91
Default

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 ???
Reply With Quote
  #8  
Old 20-10-2012, 23:13
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Keeping Dashes

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:
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

Last edited by shelbym; 20-10-2012 at 23:26. Reason: Wasn't working correctly for closed shape
Reply With Quote
  #9  
Old 21-10-2012, 06:02
vindaa vindaa is offline
Member
 
Join Date: Aug 2006
Posts: 91
Default

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

Thanks a Lot
Reply With Quote
  #10  
Old 21-10-2012, 13:13
Joe Joe is offline
Member
 
Join Date: Nov 2008
Location: Latvia
Posts: 92
Send a message via Skype™ to Joe
Wink

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:

Code:
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.
Reply With Quote
Reply


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Adding control objects after breaking apart blend L_G_D CorelDRAW/Corel DESIGNER VBA 2 22-02-2010 08:24
Breaking a curve and separating madhur General 4 22-09-2007 18:53
Macro for selecting Dimensions and Breaking it vindaa CorelDRAW/Corel DESIGNER VBA 4 14-09-2006 20:36
breaking object at corners toy4mud CorelDRAW CS 1 09-04-2005 21:12
... Non breaking Space ... Hernán General 5 06-01-2005 05:03


All times are GMT -5. The time now is 17:13.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com