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 06-03-2007, 17:25
6fazer
Guest
 
Posts: n/a
Default Move objects to selected layer (either "a" or "b")

Hi,

I am in desparate need of some macro help. I an my collegues work on many files every day in Corel and these contain a certain amount of layers. The problem is that some of these files have a layer called "Thick" and some have a layer called "Thick".

What I want to do is move selected object (curves etc.) to either layer, as either one or the other will exist.

This is what I have as a very basic code...

Code:
Sub Thick()

    ' Description:
    '                all selected to .25 black and moves to layer Thick

    Dim OrigSelection As ShapeRange
    Set OrigSelection = ActiveSelectionRange
    OrigSelection.MoveToLayer ActivePage.Layers("Thick")
    OrigSelection.SetOutlineProperties 0.009843, OutlineStyles(0), CreateRGBColor(0, 0, 0), , , , , cdrOutlineButtLineCaps, cdrOutlineRoundLineJoin
    
End Sub

The problem is if the layer is not called "Thick", but instead "THICK", I get an error. (You should also know that I have about 12 layers to sort out in this fashion).

I guess an alternative might be to get a code that searches all my layers, and if there is one called "THICK", it will change it to "Thick"

Please help
Reply With Quote
  #2  
Old 07-03-2007, 07:18
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
 
Join Date: Mar 2005
Posts: 836
Default

Code:
Sub Thick()
    Dim OrigSelection As ShapeRange, L as layer

    ' fix layer names
    For Each L In ActiveDocument.Layers
        If L.Name <> "Thick" And StrComp(L.Name, "Thick", vbTextCompare) = 0 Then L.Name = "Thick"
    Next
      
    Set OrigSelection = ActiveSelectionRange
    OrigSelection.MoveToLayer ActivePage.Layers("Thick")
    OrigSelection.SetOutlineProperties 0.009843, OutlineStyles(0), CreateRGBColor(0, 0, 0), , , , , cdrOutlineButtLineCaps, cdrOutlineRoundLineJoin
    
End Sub
Reply With Quote
  #3  
Old 07-03-2007, 08:38
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default

Here is another alternative:

Code:
Option Explicit

Private Function FindLayer(ByVal p As Page, ByVal strName As String) As Layer
    Dim lyr As Layer
    Dim lyrFound As Layer
    
    Set lyrFound = Nothing
    For Each lyr In p.Layers
        If StrComp(lyr.Name, strName, vbTextCompare) = 0 Then
            Set lyrFound = lyr
            Exit For
        End If
    Next lyr
    
    Set FindLayer = lyrFound
End Function

Sub Thick()
    With ActiveSelectionRange
        .MoveToLayer FindLayer(ActivePage, "Thick")
        .SetOutlineProperties 0.009843, OutlineStyles(0), CreateRGBColor(0, 0, 0), , , , , cdrOutlineButtLineCaps, cdrOutlineRoundLineJoin
    End With
End Sub
Reply With Quote
  #4  
Old 07-03-2007, 19:10
6fazer
Guest
 
Posts: n/a
Default

Excellent, thanks guys!

It's those magic bits of code that make the difference.
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 Selected Objects to new page maintaining layers knowbodynow CorelDRAW/Corel DESIGNER VBA 5 07-03-2007 08:49
::LayerControl:: macro for FAST layer management in CorelDraw wOxxOm CorelDRAW/Corel DESIGNER VBA 0 10-05-2006 11:40
Deselect all selected objects Alex FAQ 1 16-05-2005 14:10
Objects won't move... ddonnahoe CorelDRAW/Corel DESIGNER VBA 2 07-02-2005 07:16
VBA help needed - changing colours fremoikaner CorelDRAW/Corel DESIGNER VBA 1 18-11-2004 06:06


All times are GMT -5. The time now is 08:23.


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