View Single Post
  #1  
Old 09-02-2016, 14:39
nic nic is offline
Member
 
Join Date: May 2009
Posts: 90
Default Joining Subpaths

Hi
I have a drawing with 1,000 open curves with just two nodes per curve (at the ends) which when viewed normally seem to form one continuous (open) line. The end node of each curve being in the same x,y position as the start of the next and with the curves in z-order following the continuous line. The curves vary in linewidth with the next curve in the chain being either the same width or 0.1mm thinner or thicker (with most being the same as the one before and after).

The following macro correctly 'Combines' the 2 node curves based upon thickness of lines but ends up producing curves made up of many 2 node subpaths.

What do I need to do to produce curves where each curve is one thickness and only one subpath?

EDIT.
A. http://forum.oberonplace.com/showthread.php?t=8155

This is a question I had already asked and had answered.

sorry.


Thanks
nic

EDIT:
Code:
Set sr = ActiveLayer.Shapes.FindShapes()
For Each s In sr
s.CustomCommand "ConvertTo", "JoinCurves", 0.1
Next s
Code:
Sub JoinLines()
    
    Dim sh As Shape
    Dim sr As ShapeRange
    Dim srLine As New ShapeRange ' sr for final curve
  
    Dim w As Double ' line width

    Set sr = ActiveLayer.Shapes.FindShapes()
    Set srLine = Nothing
    
    'set width to check for at first
    w = sr(1).Outline.Width
  
    For Each s In sr

    'if line width is the one we are looking for - add to srLine
        If s.Outline.Width = w Then
            srLine.Add s
        End If

    'if NOT the same - combine the sr into a single shape, clear the sr and set thenew linewidth to look for and add the current shape to new sr
        If s.Outline.Width <> w Then
            'set the line width to the new size
            w = s.Outline.Width
            'set srLine to a single line
            srLine.Combine
            'clear the SrLine
            srLine.RemoveAll
            'add the new Shape with the new line thickness to just cleared shaperange
            srLine.Add s
        End If

    Next s
            'set the final srLine to a single line
            srLine.Combine

End Sub

Last edited by nic; 09-02-2016 at 15:20.
Reply With Quote