OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Corel User Forums > CorelDRAW > General

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 22-09-2011, 18:39
zimmerman
Guest
 
Posts: n/a
Default Marking centers of graphic

I'm trying to create center markers (triangles) to mark the vertical and horizontal centers of a selection.
Here is what I have,
Code:
Private Sub CenterMarks()
    Dim x As Double, y As Double, w As Double, h As Double
    Dim a As Double
    Dim sb As Shape
    Dim s As Shape
    Dim s1 As Shape
    Dim s2 As Shape
    Dim sr As ShapeRange
    a = 1 ' size to add to BoundingBox
    
    ActiveDocument.Unit = cdrInch
    ActiveDocument.BeginCommandGroup
    If ActiveDocument.Selection.Shapes.Count = 0 Then
        ActiveDocument.ActiveLayer.SelectableShapes.All.AddToSelection
    End If
    
    ActiveDocument.Selection.GetBoundingBox x, y, w, h, False
    Set sb = ActiveLayer.CreateRectangle2(x - a / 2, y - a / 2, w + a, h + a)
    ActiveDocument.Selection.GetBoundingBox x, y, w, h, False
    
    Set s = ActiveLayer.CreatePolygon(0, 0.5, 0.5, 0, 3)
    s.Outline.SetNoOutline
    s.Fill.UniformColor.CMYKAssign 0, 0, 0, 100
    
    Set s1 = s.Duplicate(x, y + h / 2) 'left
    s1.Rotate 90
    Set s1 = s.Duplicate(x + w, y + h / 2) 'bottom
    s1.Rotate 270
    Set s1 = s.Duplicate(x + w / 2, y) 'right
    s1.Rotate 180
    s.Move x + w / 2, y + h  'top
        
    ActiveDocument.EndCommandGroup
    Exit Sub
End Sub
The triangles do not align to the centers and I need them inside the rectangle.
Name:  IncorrectCenterMarks.png
Views: 458
Size:  8.4 KB

This is what I need
Name:  CorrectCenterMarks.png
Views: 489
Size:  8.2 KB

Thanks
James
Reply With Quote
  #2  
Old 22-09-2011, 23:52
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,787
Blog Entries: 11
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 Center Marks

Hey James, Here is my version.
Code:
Sub MyCenterMarks()
    Const dblMargin As Double = 1

    Dim sr As ShapeRange, sBox As Shape, sArrow As Shape
    Dim x As Double, y As Double, w As Double, h As Double
    
    If ActiveSelection.Shapes.Count = 0 Then ActivePage.Shapes.All.CreateSelection
    Set sr = ActiveDocument.SelectionRange
    
    sr.GetBoundingBox x, y, w, h
    Set sBox = ActiveLayer.CreateRectangle2(x - dblMargin / 2, y - dblMargin / 2, w + dblMargin, h + dblMargin)
    sBox.GetBoundingBox x, y, w, h, False
    
    Set sArrow = ActiveLayer.CreatePolygon(0, 0.5, 0.5, 0, 3)
    sArrow.Outline.SetNoOutline
    sArrow.Fill.UniformColor.CMYKAssign 0, 0, 0, 100
    sArrow.SetPositionEx cdrTopMiddle, x + w / 2, y + h
    Set sArrow = sArrow.Duplicate
    sArrow.Rotate 180
    sArrow.SetPositionEx cdrBottomMiddle, x + w / 2, y
    Set sArrow = sArrow.Duplicate
    sArrow.Rotate 90
    sArrow.SetPositionEx cdrMiddleRight, x + w, y + h / 2
    Set sArrow = sArrow.Duplicate
    sArrow.Rotate 180
    sArrow.SetPositionEx cdrMiddleLeft, x, y + h / 2
End Sub
-Shelby
Reply With Quote
  #3  
Old 23-09-2011, 10:28
zimmerman
Guest
 
Posts: n/a
Default Thanks

Thanks Shelby,

That is what I needed.

Thank you, Thank you

James
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
Create a Border from a Graphic Element jfelder General 3 28-06-2010 13:41
Graphic Styles in VBA julvr CorelDRAW/Corel DESIGNER VBA 2 15-05-2009 08:25
How to find centers of objects vratis CorelDRAW/Corel DESIGNER VBA 1 06-01-2009 23:54
Graphic And Text jocenunes CorelDRAW/Corel DESIGNER VBA 2 27-02-2008 08:13
scaling text & graphic Karen CorelDRAW CS 1 12-02-2004 13:50


All times are GMT -5. The time now is 20:57.


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