OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Corel User Forums > CorelDRAW > Macros/Add-ons

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 24-10-2011, 13:34
buga buga is offline
Senior Member
 
Join Date: Jan 2011
Posts: 114
Default Dividing curves in centimeters

Hello such.

You see, I like to make a code, but not where to begin.
I split a curve in centimeters. Perhaps adding nodes every inch. or adding a small line perpendicular to the curve every inch.
but ... How to follow the path of the line?

Could anyone please help me get started?

Thank you very much in advance.

a greeting
Reply With Quote
  #2  
Old 28-10-2011, 11:31
buga buga is offline
Senior Member
 
Join Date: Jan 2011
Posts: 114
Default

Hello again.

I have been researching on how to make the code of this post, and I found a couple of very useful macros, which combined, could get the code that I would like to do.

This code divides the curve on the nodes you want:
Code:
Option Explicit

Public Sub curveDivider()
    Dim thisDoc As Document
    Dim theseShapes As Shapes
    Dim thisShape As Shape
    Dim thisSubPath As SubPath
    Dim thisSegment As Segment
    Dim shapeCount As Long
    Dim misshapeCount As Long
    Dim dividedSegmentCount As Long
    
    Set thisDoc = ActiveDocument
    Set theseShapes = ActiveSelection.Shapes
    
    dividedSegmentCount = CLng(InputBox("Enter the number of SEGMENTS that you want to divide " _
                            & "the selected curves into:", "IsoCalc Curve Divider", _
                            theseShapes(1).Curve.Subpaths(1).Segments.count))
                            
    If dividedSegmentCount = 0 Then
        MsgBox "You must enter a value of 1 or more.", vbExclamation, "IsoCalc Curve Divider Error"
        Exit Sub
    End If
    
    misshapeCount = 0
    For Each thisShape In theseShapes
        If thisShape.Type = cdrCurveShape Then
            For Each thisSubPath In thisShape.Curve.Subpaths
                If thisSubPath.Closed = True Then
                    If divideOpenSubPath(thisSubPath, dividedSegmentCount) = False Then
                        misshapeCount = misshapeCount + 1
                    End If
                Else
                    If divideOpenSubPath(thisSubPath, dividedSegmentCount) = False Then
                        misshapeCount = misshapeCount + 1
                    End If
                End If
            Next thisSubPath
        Else
            misshapeCount = misshapeCount + 1
        End If
    Next thisShape
End Sub

Private Function divideClosedSubPath(thisSubPath As SubPath, dividedSegmentCount As Long) As Boolean

End Function

Private Function divideOpenSubPath(thisSubPath As SubPath, dividedSegmentCount As Long) As Boolean
    Dim count As Long
    For count = dividedSegmentCount - 1 To 1 Step -1
        '(count) / dividedSegmentCount To 1 / dividedSegmentCount Step -1 / dividedSegmentCount
        thisSubPath.AddNodeAt count / dividedSegmentCount '(count / (count + 1))
    Next count
End Function
This code calculates the perimeter of a curve:

Code:
Public Sub measure_perimeter()
    Dim doc As Document, old_units As Long
    Dim sDupShape As Shape
    Dim length As String, shape_count As Long
    shape_count = ActiveSelection.Shapes.Count
    If shape_count > 0 Then
        'Set the document units to horizontal ruler units
        Set doc = ActiveDocument
        doc.BeginCommandGroup "IsoCalc.com's Perimeter temporary shapes"
        old_units = doc.Unit
        doc.Unit = doc.Rulers.HUnits
        'Get the length of the shape or shapes and tidy up
        ActiveSelection.Duplicate
        ActiveSelection.UngroupAll
        Set sDupShape = ActiveSelection.Combine
        length = (sDupShape.Curve.length * doc.WorldScale) & Choose(doc.Unit + 1, " tenth-microns", _
                    " inches", " feet", "mm", "cm", " pixels", " miles", "m", _
                    "km", " didots", " Agate", "yds", " pica", " cicero", "pt", _
                    "Q", "H")
        doc.EndCommandGroup
        doc.Undo
        doc.Unit = old_units
        'Report the length
        If shape_count = 1 Then
            MsgBox "The perimeter is " & length & ".", vbOKOnly, "IsoCalc.com's Perimeter"
        Else
            MsgBox "The sum perimeter of all " & shape_count & " shapes is " & length & ".", _
                    vbOKOnly, "IsoCalc.com's Perimeter"
        End If
    End If
End Sub
You see, I like to combine these codes, so as to calculate the perimeter of the curve to calculate the number of divisions of the curve. Adding a line perpendicular to each new node, oriented curve.

Someone please help me?

continue to test to see if I get

a greeting

thanks
Reply With Quote
  #3  
Old 28-10-2011, 11:44
buga buga is offline
Senior Member
 
Join Date: Jan 2011
Posts: 114
Default

I found this code that creates a line perpendicular, but is a bit complicated for me.

Code:
Sub PerpendicularLine()
    Dim x As Double, y As Double
    Dim x0 As Double, y0 As Double, r As Double, n As Long, r0 As Double
    Dim dx As Double, dy As Double
    Dim a2 As Double
    Dim offs As Double
    
    Dim Shift As Long
    
    Dim s As Shape
    Dim sel As Shape
       
    Dim seg As Segment
    Dim seg0 As Segment
        
    If Documents.Count = 0 Then
        MsgBox "No document open.", vbCritical
        Exit Sub
    End If
    
    While ActiveDocument.GetUserClick(x, y, Shift, 1000, True, cdrCursorSmallcrosshair) = 0
        
        Set sel = ActiveDocument.ActivePage.SelectShapesAtPoint(x, y, False)

        If sel.Shapes.Count > 0 Then
            Set s = sel.Shapes(1)
       
            If s.Type = cdrCurveShape Then
            
                If s.IsOnShape(x, y) = cdrOnMarginOfShape Then
                    r = 1E+50
                    Set seg0 = Nothing
                    For Each seg In s.Curve.Segments
                        For n = 0 To 49
                            seg.GetPointPositionAt x0, y0, n / 50, cdrParamSegmentOffset
            
                            x0 = x0 - x
                            y0 = y0 - y
                            r0 = x0 * x0 + y0 * y0
                            If r0 < r Then
                                r = r0
                                Set seg0 = seg
                                offs = n / 50
                            End If
                        Next n
                    Next seg
        
                    a2 = seg0.GetPerpendicularAt(offs, cdrParamSegmentOffset) * 3.1415926 / 180
                    dx = 0.5 * Cos(a2)
                    dy = 0.5 * Sin(a2)
                    
                    With ActiveLayer.CreateLineSegment(x - dx / 2, y - dy / 2, x + dx / 2, y + dy / 2)
                        .Outline.EndArrow = ArrowHeads(1)
                    End With
                    
                    ActiveDocument.ClearSelection
                End If
            End If
        End If
    Wend
End Sub
Could someone help me simplify it, so that instead of creating lines where they click, they believe in each node automatically?

thanks in advance

a greeting
Reply With Quote
  #4  
Old 06-06-2019, 10:52
mateushenrico's Avatar
mateushenrico mateushenrico is offline
Junior Member
 
Join Date: Apr 2008
Posts: 16
Default

This code calculates the perimeter of a curve, and it is basicaly what i need.

Code:
Public Sub measure_perimeter()
    Dim doc As Document, old_units As Long
    Dim sDupShape As Shape
    Dim length As String, shape_count As Long
    shape_count = ActiveSelection.Shapes.Count
    If shape_count > 0 Then
        'Set the document units to horizontal ruler units
        Set doc = ActiveDocument
        doc.BeginCommandGroup "IsoCalc.com's Perimeter temporary shapes"
        old_units = doc.Unit
        doc.Unit = doc.Rulers.HUnits
        'Get the length of the shape or shapes and tidy up
        ActiveSelection.Duplicate
        ActiveSelection.UngroupAll
        Set sDupShape = ActiveSelection.Combine
        length = (sDupShape.Curve.length * doc.WorldScale) & Choose(doc.Unit + 1, " tenth-microns", _
                    " inches", " feet", "mm", "cm", " pixels", " miles", "m", _
                    "km", " didots", " Agate", "yds", " pica", " cicero", "pt", _
                    "Q", "H")
        doc.EndCommandGroup
        doc.Undo
        doc.Unit = old_units
        'Report the length
        If shape_count = 1 Then
            MsgBox "The perimeter is " & length & ".", vbOKOnly, "IsoCalc.com's Perimeter"
        Else
            MsgBox "The sum perimeter of all " & shape_count & " shapes is " & length & ".", _
                    vbOKOnly, "IsoCalc.com's Perimeter"
        End If
    End If
End Sub
I've been trying to add another function: at the moment the script gets the perimeter of the active curve, it also adds a text, centered the shape, with the value of its perimeter.

Is it hard to get? I couldn't so far

Could anyone of you help me?

Thanx
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
connect curves: arc curves TobWen CurveWorks 4 30-05-2008 13:47
dividing a curve into fixed distances between nodes Jeff Harrison CorelDRAW/Corel DESIGNER VBA 0 05-09-2007 04:17
A better curves dialogue... akayani CorelDRAW/Corel DESIGNER VBA 1 28-03-2006 17:54
[NewbieQ] All Curves plz Booker CorelDRAW/Corel DESIGNER VBA 4 12-12-2005 18:44
[b]Smoothing curves[/b] LOT CorelDRAW/Corel DESIGNER VBA 2 11-02-2004 09:24


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


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