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 18-02-2003, 16:11
geopig
Guest
 
Posts: n/a
Default Apply Outline - Scale with Image

Hello Alex and others,

First off I want to compliment you Alex on your great scripts and macros!! I have used the Object Replacer and Scale with Image scripts for Draw 8 in the past and they were fantastic.

I was wondering if you had plans to update these in VBA for Draw 11. I have the Object Replacer script updated to work as a script in Draw 11, but the Scale with Image does not work.

I have actually tried rewriting the Scale with Image script in VBA with little success, since I am a newbie to programming and it is quite a steep learning curve. This script was very useful especially since I typically need figures at a variety of scales. However, I have run into a wall and cannot get the macro to work properly. See the code below:

Sub ScaleOutline()
'
' Written 02/18/2003 by Geoffrey S. Pignotta
'
' Description: Apply Outline Scale with Image to all outlines in document
'
'
Dim dDoc As Document, sh As Shape
Set dDoc = ActiveDocument
dDoc.BeginCommandGroup "Outline Scale with Image"
Set sh = ActiveSelection
If sh.Outline.Type = cdrOutline Then
sh.Outline.ScaleWithShape = True
End If
dDoc.EndCommandGroup
End Sub

As you can see this is VERY basic, and problems include:
a) if an shape does not have an outline, it gives it one
b) if the first shape in the selection does not have an outline it does not apply the scale with image to any of the shapes

I have tried other If Then statements for sh.Outline.Type = cdrNoOutline in attempts to ignore shapes with no outline but with no success.

Any suggestions would be useful, or if you are working on getting this script into VBA that is fantastic.

Thanks again for your scripts and for your time,
Geoff
Reply With Quote
  #2  
Old 21-02-2003, 08:59
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default Re: Apply Outline - Scale with Image

Geoff,

You need to go through each object in the selection and make sure that it already has an outline before applying the ScaleWithShape property to it.

Also you will have to handle groups separately (you need to drill into each group and process each shape individually).

Here is how you do it:

Code:
Sub SetScaleWithShape()
    ApplyScaleWithShape ActiveSelection.Shapes
End Sub

Private Sub ApplyScaleWithShape(ss As Shapes)
    Dim s As Shape
    For Each s In ss
        Select Case s.Type
            Case cdrTextShape, cdrRectangleShape, cdrMeshFillShape, cdrPolygonShape, _
                 cdrLinearDimensionShape, cdrEllipseShape, cdrCurveShape, cdrConnectorShape
                 
                If s.Outline.Type = cdrOutline And Not s.Outline.ScaleWithShape Then
                    s.Outline.ScaleWithShape = True
                End If
                
            Case cdrGroupShape
                ApplyScaleWithShape s.Shapes
        End Select
    Next s
End Sub
Reply With Quote
  #3  
Old 24-02-2003, 12:44
geopig
Guest
 
Posts: n/a
Default

Thanks a million Alex,

Your coding worked great!

Cheers,
Geoff
Reply With Quote
  #4  
Old 07-08-2003, 05:15
glennwilton
Guest
 
Posts: n/a
Default

One flaw is that this will not include the contents of PowerClips.

You need to include :
If Not s.PowerClip Is Nothing Then ApplyScaleWithShape s.PowerClip.Shapes

Code:
Sub SetScaleWithShape() 
    ApplyScaleWithShape ActiveSelection.Shapes 
End Sub 

Private Sub ApplyScaleWithShape(ss As Shapes) 
    Dim s As Shape 
    For Each s In ss 


      If Not s.PowerClip Is Nothing Then ApplyScaleWithShape s.PowerClip.Shapes



        Select Case s.Type 
            Case cdrTextShape, cdrRectangleShape, cdrMeshFillShape, cdrPolygonShape, _ 
                 cdrLinearDimensionShape, cdrEllipseShape, cdrCurveShape, cdrConnectorShape 
                  
                If s.Outline.Type = cdrOutline And Not s.Outline.ScaleWithShape Then 
                    s.Outline.ScaleWithShape = True 
                End If 
                
            Case cdrGroupShape 
                ApplyScaleWithShape s.Shapes 
        End Select 
    Next s 
End Sub
Reply With Quote
  #5  
Old 06-05-2004, 07:23
DaFool
Guest
 
Posts: n/a
Default

is this available for download?
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
Image picture location RVogel CorelDRAW/Corel DESIGNER VBA 0 31-03-2005 12:05
CD 10, VBA not returning true outline width Webster CorelDRAW/Corel DESIGNER VBA 1 24-11-2004 17:09
Population of Image Box ddonnahoe CorelDRAW/Corel DESIGNER VBA 10 10-02-2004 13:20
Import image into bounding box Craig Tucker CorelDRAW/Corel DESIGNER VBA 2 07-10-2003 20:06
fonts used by a CDR image spelhatre CorelDRAW/Corel DESIGNER VBA 1 04-04-2003 11:12


All times are GMT -5. The time now is 06:09.


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