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 29-07-2005, 14:48
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 Processing inside groups

DRAW12
How can I adapt the following code to process objects inside of groups?
It currently makes all objects with outlines set to ScaleWithShape.
Code:
Option Explicit

Sub ScaleOutlines()
    Dim s As Shape
    Dim d As Document
    
    For Each s In ActivePage.Shapes
        If s.Outline.Width <> 0# Then
            If s.Outline.ScaleWithShape = False Then
                s.Outline.ScaleWithShape = True
            End If
        End If
    Next s
End Sub
__________________
Sean
Waiting for a ride in the T.A.R.D.I.S.
Reply With Quote
  #2  
Old 29-07-2005, 15:09
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default

One of the easiest way to do it is this:

Code:
Dim s As Shape
For Each s In ActivePage.FindShapes()
    ' Do your processing here
Next s
FindShapes will walk through object tree and pick up every object, even within groups (because its Recursive parameter has a default value of True).
Reply With Quote
  #3  
Old 29-07-2005, 15:28
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

I thought, "Hmm, this ought to be cool!" But alas, there is yet another conundrum.
Here is my revised code...
Code:
Option Explicit

Sub ScaleOutlines()
    Dim s As Shape
    Dim d As Document
    
    For Each s In ActivePage.FindShapes()
        If s.Outline.Width = 0# Then Exit Sub  '<-- This is the suspect line of code.
        
        If s.Outline.ScaleWithShape = False Then
                s.Outline.ScaleWithShape = True
        End If
    Next s
End Sub
I get the following error everytime I run the macro. Could it be becase my measurements are based on inches instead of points?
Attached Images
 
__________________
Sean
Waiting for a ride in the T.A.R.D.I.S.
Reply With Quote
  #4  
Old 31-07-2005, 09:17
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
 
Join Date: Mar 2005
Posts: 836
Default

this happens because not all of the objects have outline property. In order to bypass error without additional checking for existence of outline property, you may oput this line right after sub statement:

Code:
on error resume next
;-)
Reply With Quote
  #5  
Old 01-08-2005, 09:01
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

This still does not turn on ScaleWithObject for objects in a group. Kinda defeats the purpose.
__________________
Sean
Waiting for a ride in the T.A.R.D.I.S.
Reply With Quote
  #6  
Old 01-08-2005, 09:26
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

This is becoming very frustrating. All I want to do is cycle through all objects on a page and turn on ScaleWithObject property for all objects, wether they are grouped or not. I thought this would be very simple.

Adding "On Error Resume Next" only skipped the grouped objects and I'm getting confused on the ActivePage.FindShapes() method.
__________________
Sean
Waiting for a ride in the T.A.R.D.I.S.
Reply With Quote
  #7  
Old 01-08-2005, 11:19
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
 
Join Date: Mar 2005
Posts: 836
Default

I use this code, it's OK:
Code:
sub outscale()
   Dim s As Shape, sr As New ShapeRange
   Set sr = ActivePage.FindShapes()
   On Error Resume Next
   sr.AddRange ActiveDocument.Pages(0).Layers("Desktop").FindShapes()
   
   ActiveDocument.BeginCommandGroup "Scale outline ON"
   Optimization = True
   EventsEnabled = False
   ActiveDocument.SaveSettings
   ActiveDocument.PreserveSelection = False
   
   For Each s In sr
      s.Outline.ScaleWithShape = True
   Next s
   
   EventsEnabled = True
   ActiveDocument.RestoreSettings
   ActiveDocument.EndCommandGroup
End Sub
Reply With Quote
  #8  
Old 07-08-2005, 14:09
petig
Guest
 
Posts: n/a
Default

Hi ! There is another way, that needs two procedures. It shows, how can make more sophisticated, because you can decide, wether works inside groups or not. The second procedure a function (or maybe sub also), that works recursively, when a group is found. (I Find the idea in the Corel VBA help...)

Code:
Option Explicit

Sub EnablingOutlineScaling()

If ActiveDocument Is Nothing Then End
Dim shs As Shapes, ingr As Boolean, i As Integer

If ActiveShape Is Nothing Then
   If MsgBox("There is no any selection. Would you enabling all the outlines scaling " & _
      "on the current page?", vbYesNo, ":: Enabling Outlines Scaling ::") = vbYes Then
      Set shs = ActivePage.Shapes
   Else
      Exit Sub
   End If
Else
   Set shs = ActiveSelection.Shapes
End If

If MsgBox("Would you enabling outlines scaling inside groups too?", _
   vbYesNo, ":: Enabling Outlines Scaling ::") = vbYes Then
   ingr = True
Else
   ingr = False
End If

Application.Optimization = True
ActiveDocument.PreserveSelection = False
ActiveDocument.BeginCommandGroup "Enabling Outlines Scaling"

MsgBox DoEnablingOutlineScaling(shs, ingr, 0) & " outlines scaling enabled", _
       vbInformation, ":: Enabling Outlines Scaling ::"

ActiveDocument.EndCommandGroup

ActiveDocument.PreserveSelection = True
Application.Optimization = False
Application.Windows.Refresh

End Sub

Function DoEnablingOutlineScaling(shs As Shapes, ingr As Boolean, i As Integer) As Integer

Dim sh As Shape

For Each sh In shs
   If sh.Type = cdrGroupShape Then
      If ingr Then DoEnablingOutlineScaling sh.Shapes, True, i
   Else
      If sh.Outline.Type = cdrOutline Then
         sh.Outline.ScaleWithShape = True
         i = i + 1
      End If
   End If
Next

DoEnablingOutlineScaling = i

End Function
OK, it works only on the current page, not on Desktop, but that is only few rows to add. On other hand, I think, not so good idea in wOxxOm code that three line:

Code:
For Each s In sr
      s.Outline.ScaleWithShape = True
Next s
because it makes outline to objects, what hadn't. And I think also, better way to use the Shape.Outline.Type property instead of check it's weight.

And, I have an question, too, if anyone can help, please do it. How can I reselect the original selection with some easy steps? Whats wrong in this example?
Reply With Quote
  #9  
Old 07-08-2005, 15:34
petig
Guest
 
Posts: n/a
Default A little supplement

Well. I tried again, because I forgot a little (?) bug in Corel VBA (maybe just in CDR.v11 what I work with). These examples will not work fine and will stop, when a Linear Dimension Shape or an Artistic Media Group Shape is found. In CorelDraw user interface (e.g. on Properties panel) them outline property works well, maybe make any change "by hand", but VBA macros find them like cdrTextShape, or cdrCurveShape. Because that, from VBA these shapes (groups) are not detectables and cause an error, if any properties of them is tried to queried or changed. The only (and not so nice) solution that I know, to break tham appart manualy before run macros like the example. The similar is the situation with the interactive contour, interactive blend, interactive extrude and interactive dropshadow objects. If you are not sure, and want just testing, in your work is any object like above, in macros comment out the Application.Optimization = True, ActiveDocument.BeginCommandGroup and ActiveDocument.EndCommandGroup lines, because these may not "restore" from the user interface, and your document may be corrupted, if macros can't terminate normaly. For details see the VBA help.

If I have mistaken, Alex, please correct me.
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
How to place a bitmap inside text or other objects? Alex FAQ 1 24-05-2005 12:01
BUG - Lens Effect inside a Powerclip.jpg Hernán General 3 09-04-2005 00:06
Multiple Groups & Align Under kuty CorelDRAW/Corel DESIGNER VBA 2 17-08-2004 14:21
Select objects inside another shelbym CorelDRAW/Corel DESIGNER VBA 1 25-11-2003 17:01


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


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