OberonPlace.com Forums  

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

Thread Tools Search this Thread Display Modes
Old 26-04-2005, 09:33
Posts: n/a
Default Emulating the "treeline" effect in AutoCAD

Has (or would) anyone put together a script that would do something similar to Alex's "roughen" feature to allow conversion of a curve to a line that looks like a treeline (boundary of a stand of trees) that can be drawn from within AutoCAD? I'm not very experienced in VBA, but it seems that it might not be too difficult to modify Alex's code to produce a series of semi-circular "punch-outs" instead of very angular ones.

Thanks in advance!
Reply With Quote
Old 26-04-2005, 10:51
Alex's Avatar
Alex Alex is offline
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default Re: Emulating the "treeline" effect in AutoCAD

Dan, Can you attach a sample picture of the effect you are after. I'm not familiar with AutoCAD's treeline effect (I can guess how it should look but just to make sure I understand your requirements correctly).
Reply With Quote
Old 26-04-2005, 11:06
Posts: n/a
Default "treeline" image uploaded

sorry, i should have done this to begin with.
Attached Images
Reply With Quote
Old 16-05-2005, 10:10
Posts: n/a
Default just curious

Hi there, i was just curious whether anyone thought they might be willing to take on this "little" exercise?
Reply With Quote
Old 16-05-2005, 15:01
Alex's Avatar
Alex Alex is offline
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4

Ok, I tried the excercise and here is what I came up with...

You need to create your curve, select a few nodes with the Shape tool to indicate which segments should be turned into treeline effect and run the following macro:

Sub CreateTreeLineEffect()
    Dim sCurve As Shape, sCircle As Shape
    Dim sr As New ShapeRange
    Dim nStart As Node
    Dim nEnd As Node
    Dim nrSel As NodeRange
    Const dCircleRadius As Double = 0.2
    Dim dLenFrom As Double
    Dim dLenTo As Double
    Dim nSegIdx As Long
    Dim t As Double
    Dim x As Double, y As Double
    Set sCurve = ActiveShape
    ' Validate the selection first
    If sCurve Is Nothing Then
        MsgBox "Nothing selected!", vbCritical
        Exit Sub
    End If
    If sCurve.Type <> cdrCurveShape Then
        MsgBox "Only a curve object must be selected!", vbCritical
        Exit Sub
    End If
    If sCurve.Curve.SubPaths.Count > 1 Then
        MsgBox "The curve can't have more than 1 subpath", vbCritical
        Exit Sub
    End If
    If Not sCurve.Curve.Closed Then
        MsgBox "The curve must be closed!", vbCritical
        Exit Sub
    End If
    Set nrSel = sCurve.Curve.Selection
    Select Case nrSel.Count
        Case 0, Is = sCurve.Curve.Nodes.Count
            ' No node selection, or all the nodes selected: process the whole object then
            Set nStart = sCurve.Curve.Nodes(1)
            Set nEnd = nStart
        Case 1
            ' Only 1 node selected. Not enough input
            MsgBox "Please select more than one node", vbCritical
            Exit Sub
        Case Else
            Set nStart = nrSel(1)
            While IsNodeInRange(nrSel, nStart.Previous)
                Set nStart = nStart.Previous
            Set nEnd = nStart
            While IsNodeInRange(nrSel, nEnd.Next)
                Set nEnd = nEnd.Next
    End Select

    ' Find the piece of subpath where the treeline should be created
    dLenFrom = 0
    For nSegIdx = 1 To nStart.NextSegment.Index - 1
        dLenFrom = dLenFrom + sCurve.Curve.Segments(nSegIdx).Length
    Next nSegIdx
    dLenTo = dLenFrom
    For nSegIdx = nStart.NextSegment.Index To nEnd.PrevSegment.Index
        dLenTo = dLenTo + sCurve.Curve.Segments(nSegIdx).Length
    Next nSegIdx
    ' Now create circles along the selected part of the curve
    For t = dLenFrom + dCircleRadius To dLenTo - dCircleRadius + 0.0001 Step 2 * dCircleRadius
        sCurve.Curve.SubPaths(1).GetPointPositionAt x, y, t, cdrAbsoluteSegmentOffset
        sr.Add ActiveLayer.CreateEllipse2(x, y, dCircleRadius)
    Next t
    ' Finally, weld our curve and the circles to create the treeline effect...
    sr.Group.Weld sCurve
End Sub

Private Function IsNodeInRange(ByVal nr As NodeRange, ByVal n As Node) As Boolean
    Dim bFound As Boolean
    Dim nTest As Node
    bFound = False
    For Each nTest In nr
        If nTest.AbsoluteIndex = n.AbsoluteIndex Then
            bFound = True
            Exit For
        End If
    Next nTest
    IsNodeInRange = bFound
End Function
It determines which segments are selected, then creates a bunch of circles on top of your curve so that the circles are placed along the specified portion of the curve and finally welds the curve and the circles together to achieve the effect you want...

I hope this is something you can start with...
Reply With Quote

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
BUG - Lens Effect inside a Powerclip.jpg Hernán General 3 08-04-2005 23:06

All times are GMT -5. The time now is 19:52.

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