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 02-01-2003, 15:34
RobC
Guest
 
Posts: n/a
Default How can I copy an Envelope?

I have created a document on which there is a single object. This object has an envelope applied to it. I want to copy this envelope to a new object. my code follows

Code:
Sub Test()
    Dim s1 As Shape, s2 As Shape
    
    Set s1 = ActiveLayer.Shapes(1)
    Set s2 = ActiveLayer.CreateArtisticText(2.75, 5, "Vorsprung Durch Technik")
    s2.Text.FontProperties.Size = 150

    s2.CreateEnvelope 1, cdrEnvelopeOriginal
    s2.Effect.Envelope.CopyFrom s1.Effect.Envelope
End Sub
the last line errors with "this shape is not the correct type to support this property or method" Runtime error -2147467262 (80004002).

Any ideas?

s1 could be an enveloped rectangle, or an artistic text. same error either way. I have attached a cdr as an example.

Rob
Attached Files
File Type: cdr envelope.cdr (21.2 KB, 437 views)
Reply With Quote
  #2  
Old 17-01-2003, 14:29
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default Re: How can I copy an Envelope?

Rob,

Your problem is using Shape.Effect property. It is available only for shapes that are actually the result of an effect. For example, a blend consists of three shapes - the two are the control objects between which the blend is created and the third is the blend group itself. So, if you call Shape.Effect on the blend group shape, it will return you the blend effect, but if you try to call it on either of the control shapes - it will fail. Instead, you need to go through Shape.Effects collection because there could be many effects applied to the same shape.

So, in your case, you need to do the following:

Code:
Sub Test1()
    Dim s1 As Shape, s2 As Shape
    
    Set s1 = ActiveLayer.Shapes(1)
    Set s2 = ActiveLayer.CreateArtisticText(2.75, 5, "Vorsprung Durch Technik")
    s2.Text.FontProperties.Size = 150

    s2.CreateEnvelope 1, cdrEnvelopeOriginal
    s2.Effects(1).Envelope.CopyFrom s1.Effects(1).Envelope
End Sub
You can optimize this code slightly knowing that Shape.CreateEnvelope returns you the Effect object you need, so you can re-write your code as follows:

Code:
Sub Test2()
    Dim s1 As Shape, s2 As Shape
    Dim eff As Effect
    
    Set s1 = ActiveLayer.Shapes(1)
    Set s2 = ActiveLayer.CreateArtisticText(2.75, 5, "Vorsprung Durch Technik")
    s2.Text.FontProperties.Size = 150

    Set eff = s2.CreateEnvelope(1, cdrEnvelopeOriginal)
    eff.Envelope.CopyFrom s1.Effects(1).Envelope
End Sub
Obviously you need to ensure that the original shape has envelope applied to it and it is the item #1 in the Effects collection. So, instead of using s1.Effects(1).Envelope it would be more correct to go through all elements of Effects collection until you find an effect of type cdrEnvelope.
Reply With Quote
  #3  
Old 20-01-2003, 13:59
RobC
Guest
 
Posts: n/a
Default

Alex-

Thanks. That was really puzzling to me.

Rob
Reply With Quote
  #4  
Old 29-08-2005, 09:30
cristov
Guest
 
Posts: n/a
Default How can I copy an envelope o one object to several others?

Hello,

I got one object with the wanted envelope and I want to select several others and apply the wanted envelope to them.
Im not used to program in VBA and would be thankful for any help.
Reply With Quote
  #5  
Old 29-08-2005, 10:42
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
 
Join Date: Mar 2005
Posts: 836
Default

Quote:
Originally Posted by cristov
Hello,

I got one object with the wanted envelope and I want to select several others and apply the wanted envelope to them.
Im not used to program in VBA and would be thankful for any help.
the easiest way is to use eyedropper tool and in its property bar you must select "object attributes" instead of "sample color", then open dropdown menu "effects" in property bar, and check "[ x ] Envelope", click original object with envelope, then shift-click all the objects you want.
Reply With Quote
  #6  
Old 29-08-2005, 12:25
petig
Guest
 
Posts: n/a
Default

Probably this is the easiest way and the best too. I tried with macro, and I don't know why, the copy was not the same as the original (I tried on duplicated shapes). However if anyone need to do so with macro anyhow (because a lot of repetition), here is the code:

Code:
Option Explicit

Sub CopyEffectToSelection()

Dim sr As New ShapeRange, sh As Shape, base As Shape, eff As EffectEnvelope
Dim x As Double, y As Double, i As Long

If ActiveDocument Is Nothing Then End
If ActiveSelectionRange.Count < 1 Then
   MsgBox "You must select at least one object to copy envelope to.", vbCritical
   End
End If

Set sr = ActiveSelectionRange

MsgBox "You get 5 seconds to point the shape what's envelope should be copied.", vbInformation
If ActiveDocument.GetUserClick(x, y, i, 5, False, cdrCursorPick) Then
   MsgBox "Esc key pressed or time out occured. Exit without change.", vbExclamation
   End
Else
   For Each sh In ActivePage.FindShapes()
      If sh.IsOnShape(x, y) Then
         Set base = sh
         Exit For
      End If
   Next sh
   If base Is Nothing Then
      MsgBox "You missed, no base object selected. Exit without change.", vbExclamation
      End
   End If
End If

i = 1

For i = 1 To base.Effects.Count
   If base.Effects(i).Type = cdrEnvelope Then
      Set eff = base.Effects(i).Envelope
      Exit For
   End If
Next i

If i > base.Effects.Count Then
   MsgBox "The pointed shape has no envelope. Exit without change.", vbCritical
   End
End If

For Each sh In sr
   If Not sh.StaticID = base.StaticID Then
      sh.CreateEnvelope(1).Envelope.CopyFrom eff
   End If
Next sh

End Sub
Reply With Quote
  #7  
Old 29-08-2005, 12:44
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
 
Join Date: Mar 2005
Posts: 836
Default

i've seen it too, very funny - lines are slightly distorted: I've drawn black circle, copied it 4 times, applied to first simple custom envelope, ran the macro, then aligned all objects to center and didn't believe my eyes ;-) the shape lines are not the same! sorry it was such a surprise ;-) he he

Solution (crooked though): populate all the curves with intermediate nodes using some macro or write your own. I did it, it helps, but the new problem is that you'll have 10x more points in curves and you'll have to auto-reduce them........
Reply With Quote
  #8  
Old 30-08-2005, 03:14
cristov
Guest
 
Posts: n/a
Default

Quote:
Originally Posted by wOxxOm
the easiest way is to use eyedropper tool and in its property bar you must select "object attributes" instead of "sample color", then open dropdown menu "effects" in property bar, and check "[ x ] Envelope", click original object with envelope, then shift-click all the objects you want.
do you mean the eyedroppertool of the envelopetoolbar | effects>envelope ?

for one object selected the eyedroppertool works fine, but if one selects more than one, you always have to confirm the copy process.

where do i find the property bar where i have to change from "sample color" to
"object attributes", and what do you mean with shift-click?
Reply With Quote
  #9  
Old 30-08-2005, 03:38
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
 
Join Date: Mar 2005
Posts: 836
Default

Quote:
Originally Posted by cristov
where do i find the property bar where i have to change from "sample color" to "object attributes", and what do you mean with shift-click?

In CorelDraw12 only ;-) not 11 ;-) eyedropper tool is on tools-palette and it has extended, very extended attribute-copying capabilities... whithout confirmations, works silently & swiftly. Swoooosh & done ;-)
Reply With Quote
  #10  
Old 30-08-2005, 05:55
cristov
Guest
 
Posts: n/a
Default

Quote:
Originally Posted by wOxxOm
the easiest way is to use eyedropper tool and in its property bar you must select "object attributes" instead of "sample color", then open dropdown menu "effects" in property bar, and check "[ x ] Envelope", click original object with envelope, then shift-click all the objects you want.
updated to CDRAW12, found the desired eyedropper, thank you a lot for that hint.
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
Copy Properties > all xombie CorelDRAW/Corel DESIGNER VBA 2 18-04-2005 15:50
object lost it's linear fountain fill property after metalickaah CorelDRAW/Corel DESIGNER VBA 5 02-01-2005 23:36
Copy to Adobe Illustrator Macro Tallywhacker Macros/Add-ons 2 24-05-2004 08:07
Copy and paste objects in CDR9 macnab CorelDRAW/Corel DESIGNER VBA 0 03-09-2003 11:59
Placing a custom envelope on Text larrypanattoni CorelDRAW/Corel DESIGNER VBA 3 23-04-2003 10:18


All times are GMT -5. The time now is 00:31.


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