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 27-01-2006, 01:11
amollondhe
Guest
 
Posts: n/a
Question Urgent: Alex please Help

Hi,

I have few shpes drawn in my drawing in corel designer12. This drawings are grouped and put on to some layer as per some rules.

This group contains text object and two curve objects,i want to change one curve object to rectangle.I have tried using shape.type,but it is a Read only property.

Could someone please tel me how to loop through the group and chage the type of the shape from curve to rectangle(cdrRectangleShape)

i have been working on this for 6 days but not finiding workaround.

Kind request to Alex to please give solution.

Thank you guys
Reply With Quote
  #2  
Old 27-01-2006, 08:25
ddonnahoe's Avatar
ddonnahoe ddonnahoe is offline
Senior Member
 
Join Date: Jan 2004
Location: Louisville, KY
Posts: 552
Send a message via ICQ to ddonnahoe Send a message via AIM to ddonnahoe Send a message via MSN to ddonnahoe Send a message via Yahoo to ddonnahoe
Default

Quick answer...
you could search for that particular shap and use GetBoundingBox, then with the results, create a new rectangle over top of it and optionally delete the original object.
__________________
Sean
Waiting for a ride in the T.A.R.D.I.S.
Reply With Quote
  #3  
Old 27-01-2006, 17:24
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 Rectangle

That is what I would do, loop thru, find the shape get the size, then create the new rectangle, there is no convert to rectangle that I know of, you have to create a new one.

Shelby
Reply With Quote
  #4  
Old 27-01-2006, 21:58
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default

Here is my take on this. The biggest problem is how you want to find your curve to replace. There are a few ways of doing this. Let's just assume you know that your curve that needs to be replaced with a rectange is the second curve on page (in the Z-Order, that is, the second curve to appear in object manager).

Here is how you would replace it with a rectangle of the same size:

Code:
Option Explicit

Sub ReplaceSecondCurveWithRect()
    Dim sCurveToReplace As Shape
    
    ' Find the curve we want to replace
    Set sCurveToReplace = FindTargetCurve()
    ' Make sure we did find the curve
    If sCurveToReplace Is Nothing Then
        MsgBox "Cannot find our curve of interest", vbCritical
        Exit Sub
    End If
    
    ' Replace the curve with rectangle
    ReplaceCurveWithRect sCurveToReplace
End Sub

Private Function FindTargetCurve() As Shape
    Dim sCurve As Shape
    Dim sr As ShapeRange
    
    ' Get the list of all the curves in the page
    Set sr = ActivePage.FindShapes(Type:=cdrCurveShape)
    ' Let's assume we want the second curve on the page
    ' Make sure that there is at least two curves present
    If sr.Count >= 2 Then
        Set sCurve = sr(2)
    Else
        Set sCurve = Nothing
    End If
    
    Set FindTargetCurve = sCurve
End Function

Private Sub ReplaceCurveWithRect(ByVal sCurveToReplace As Shape)
    Dim sRect As Shape
    Dim x As Double, y As Double, sx As Double, sy As Double
    
    ' Get the size and position of the curve
    sCurveToReplace.GetBoundingBox x, y, sx, sy
    ' Create the rectangle to replace the curve
    Set sRect = ActiveLayer.CreateRectangle2(x, y, sx, sy)
    ' Copy the original curve's fill and outline properties
    sRect.Fill = sCurveToReplace.Fill
    With sCurveToReplace.Outline
        sRect.Outline.SetProperties .Width, .Style, .Color, .StartArrow, .EndArrow, _
                                    .BehindFill, .ScaleWithShape, .LineCaps, _
                                    .LineJoin, .NibAngle, .NibStretch
    End With
    ' Put the rectangle right on top of the curve in Z-Order
    ' (this will move the rectangle inside a group, if the curve
    ' is in a group itself)
    sRect.OrderFrontOf sCurveToReplace
    ' Finally delete the curve
    sCurveToReplace.Delete
End Sub
The function FindTargetCurve finds the second curve on the page and then the curve object returned is replaced with a rectangle in ReplaceCurveWithRect. If you want a different algorithm of finding the curve, you can replace the body of FindTargetCurve with whatever works best.

For example, you can give a special name to the curve to be replaced (e.g. select the curve in CorelDRAW, then go to Object Manager and click the selected item in the tree again. This will put it in editing mode and rename the curve to, say, "Target"). Then you can easily search for the target curve by specifying its name:

Code:
Private Function FindTargetCurve() As Shape
    Set FindTargetCurve = ActivePage.FindShape(Name:="Target")
End Function
I hope this helps.
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
Alex, How do you do it? ddonnahoe CorelDRAW/Corel DESIGNER VBA 1 20-11-2004 01:25
Alex - on behalf of myself and many others a BIG THANKS !! D_Green CorelDRAW/Corel DESIGNER VBA 3 14-09-2004 13:38
Alex is a Programming GOD shelbym CorelDRAW/Corel DESIGNER VBA 1 21-07-2004 15:36
Thank u Alex !How about my new design! lees CorelDRAW/Corel DESIGNER VBA 1 11-05-2004 11:02
Urgent: I need Tiler-Script as a CorelDraw11-Makro Layout-herber CorelDRAW/Corel DESIGNER VBA 1 22-04-2003 22:44


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


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