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 21-07-2005, 15:28
petig
Guest
 
Posts: n/a
Default How controll lot of layers?

Hi everybody!
I work in CorelDraw 11 with a lot of layers, usaly 5-700 objects in each docs. To clicking on thousand and one times on little eyes, printers and pencils was an everydays project, until I bored it and decided to do something. Here is the result. In this gms fifteen macros, such as Show All Layers, Activate Last Object's Layer, Hide Locked. These are very shorts, only few rows. For each has a oneline comment in the modul to describe what it does. If you found usable or bugy any of them, please write me which are that, in e-mail to petigabi@freestart.hu or post it here. By the way I think those shoud be taken on the CD13 wish list. Please, also write me if I had been mistaken. Thanks, best regards: PG
Attached Files
File Type: zip LayersPlus.zip (7.9 KB, 515 views)
Reply With Quote
  #2  
Old 21-07-2005, 16:16
Jadus
Guest
 
Posts: n/a
Default Question about Uploads

Are the uploads here scanned for viruses?

Also, is it possible for someone to write malicious code and pose it as a library?

Just curious.

Dave
Reply With Quote
  #3  
Old 21-07-2005, 16:26
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,778
Blog Entries: 10
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 Melicious Code

I don't know the answer to the virus question, but I am sure if one wanted to they could write some melicious code and post it. Best thing to do is review all code, and make sure you know what it is doing.

Shelby
Reply With Quote
  #4  
Old 21-07-2005, 17:29
petig
Guest
 
Posts: n/a
Default

Ohh, exuse me, I forgot to write it. Yes, scanned. Here is the code, you can check it by yourself also.

Code:
Attribute VB_Name = "LayoutPlus"
Option Explicit
Dim obj As Shape, lay As Layer

' If have any suggestions or found bugs, please e-mail me: petigabi@freestart.hu
' Feel free to use and give your friends, if found handy. Best regards. 2005-07-21
'
' These macros don't affect Masterlayers (Desktop, Guides, Grid)

Public Sub LastShapeLayerActivate()
' Activates the last selected shape's layer
' At DragSelect or SelectAll activates the bottommost shape's layer
If ActiveDocument Is Nothing Then End
If ActiveShape Is Nothing Then Exit Sub
If ActiveDocument.ShapeEnumDirection = cdrShapeEnumTopFirst Then
   ActiveSelection.Shapes(1).Layer.Activate
Else
   ActiveSelection.Shapes(ActiveSelection.Shapes.Count).Layer.Activate
End If
End Sub

Public Sub SelectActiveLayer()
' Selects all the active layer's shapes
If ActiveDocument Is Nothing Then End
ActiveDocument.ClearSelection
ActiveLayer.Editable = True
ActiveLayer.Visible = True
ActiveLayer.Shapes.All.AddToSelection
End Sub

Public Sub SelectExtendActiveLayer()
' Extends the selection with all the active layer's shapes
If ActiveDocument Is Nothing Then End
ActiveLayer.Editable = True
ActiveLayer.Visible = True
ActiveLayer.Shapes.All.AddToSelection
End Sub

Public Sub DeselectActiveLayer()
' Deselects all the active layer's shapes
If ActiveDocument Is Nothing Then End
ActiveLayer.Shapes.All.RemoveFromSelection
End Sub

Public Sub SelectActiveShapesLayers()
' Selects all the shapes on layers of the selected shapes
If ActiveDocument Is Nothing Then End

Dim laylist As String
laylist = ChrW(0)

For Each obj In ActiveSelectionRange
   If InStr(1, laylist, ChrW(0) & obj.Layer.Name & ChrW(0), 0) = 0 Then
      ActivePage.Layers(obj.Layer.Name).Shapes.All.AddToSelection
      laylist = laylist & obj.Layer.Name & ChrW(0)
   End If
Next obj

End Sub

Public Sub ShowAllLayers()
' Shows all layers in a single task
If ActiveDocument Is Nothing Then End
ActiveDocument.BeginCommandGroup "Show All Layers"
For Each lay In ActivePage.Layers
   lay.Visible = True
Next lay
ActiveDocument.EndCommandGroup
End Sub

Public Sub ShowOnlyActiveLayer()
' Hides the not active layers in a single task
If ActiveDocument Is Nothing Then End
ActiveDocument.BeginCommandGroup "Hide Nonactive Layers"
For Each lay In ActivePage.Layers
   If lay.Name = ActiveLayer.Name Then
      lay.Visible = True
   Else
      lay.Visible = False
   End If
Next lay
ActiveDocument.EndCommandGroup
End Sub

Public Sub ShowOnlyEditableLayers()
' Hides the locked layers and shows the editables
If ActiveDocument Is Nothing Then End
For Each lay In ActivePage.Layers
   lay.Visible = lay.Editable
Next lay
End Sub

Public Sub ShowOnlyPrintableLayers()
' Hides the nonprintable layers, shows the printables
If ActiveDocument Is Nothing Then End
For Each lay In ActivePage.Layers
   lay.Visible = lay.Printable
Next lay
End Sub

Public Sub HideOtherLayers()
' Hides the layers without any selected object
If ActiveDocument Is Nothing Then End

If ActiveShape Is Nothing Then
   MsgBox "No selection, no changes.", vbInformation, ":: Hide other layers ::"
   Exit Sub
End If

Application.Optimization = True
Dim laylist As String
laylist = ChrW(0)

For Each obj In ActiveSelection.Shapes
   If InStr(1, laylist, ChrW(0) & obj.Layer.Name & ChrW(0), 0) = 0 Then laylist = laylist & obj.Layer.Name & ChrW(0)
Next obj

For Each lay In ActivePage.Layers
   If InStr(1, laylist, ChrW(0) & lay.Name & ChrW(0), 0) = 0 Then lay.Visible = False
Next lay

Application.Optimization = False
Application.Windows.Refresh
Application.Refresh

End Sub

Public Sub UnlockAllLayers()
' Unlocks all the layers
If ActiveDocument Is Nothing Then End
ActiveDocument.EditAcrossLayers = True
For Each lay In ActivePage.Layers
   lay.Editable = True
Next lay
End Sub

Public Sub LockOtherLayers()
' Locks the layers without any selected object
If ActiveDocument Is Nothing Then End
If ActiveShape Is Nothing Then
   If MsgBox("Nothing is selected. Lock all the layers?", vbYesNo, ":: Lock layers ::") = vbNo Then Exit Sub
End If

Dim laylist As String

laylist = ChrW(0)

For Each obj In ActiveSelection.Shapes
   If InStr(1, laylist, ChrW(0) & obj.Layer.Name & ChrW(0), 0) = 0 Then laylist = laylist & obj.Layer.Name & ChrW(0)
Next obj

For Each lay In ActivePage.Layers
   If InStr(1, laylist, ChrW(0) & lay.Name & ChrW(0), 0) = 0 Then lay.Editable = False
Next lay

End Sub

Public Sub LockShowHiddenLayers()
' Shows the hiden layers with locked
If ActiveDocument Is Nothing Then End

For Each lay In ActivePage.Layers
   If lay.Visible = False Then
      lay.Editable = False
      lay.Visible = True
   End If
Next lay

End Sub

Public Sub SincLayersPrintShow()
' The hidden layers becomes nonprintable
If ActiveDocument Is Nothing Then End
For Each lay In ActivePage.Layers
    lay.Printable = lay.Visible
Next lay
End Sub

Public Sub DelEmptyLayers()
' Deletes unused layers
If ActiveDocument Is Nothing Then End

For Each lay In ActivePage.Layers
   If ActivePage.Layers.Count = 1 And lay.Shapes.Count = 0 Then
      MsgBox "At least one layer needed, even if empty...", vbInformation, ":: Delete empty layers ::"
   ElseIf lay.Shapes.Count = 0 Then
      lay.Delete
   End If
Next lay
End Sub

Public Sub DelEmptyPages()
' Deletes unused pages
If ActiveDocument Is Nothing Then End

Dim p As Page

For Each p In ActiveDocument.Pages
   If ActiveDocument.Pages.Count = 1 And ActivePage.Shapes.Count = 0 Then
      MsgBox "The only one page is empty, but must remain.", vbInformation, ":: Delete empty pages ::"
   ElseIf lap.Shapes.Count = 0 Then
      p.Delete
   End If
Next p
End Sub
Good by...

Last edited by petig; 21-07-2005 at 17:40.
Reply With Quote
  #5  
Old 26-07-2005, 05:52
petig
Guest
 
Posts: n/a
Default Typing mistake

In the last sub I found a typing mistake. Because that I rewrite the last two:

Code:
Public Sub DelEmptyLayers()
' Deletes unused layers
If ActiveDocument Is Nothing Then End

Dim i As Integer
i = 0

ActiveDocument.BeginCommandGroup "Delete Empty Layers"

For Each lay In ActivePage.Layers
   If lay.Shapes.Count = 0 Then
      If ActivePage.Layers.Count = 1 Then
         MsgBox "The last layer nondeletable...", vbInformation, ":: Delete Empty Layers ::"
      Else
         lay.Delete
         i = i + 1
      End If
   End If
Next lay

ActiveDocument.EndCommandGroup

If i > 0 Then MsgBox i & " empty layers deleted.", vbInformation, ":: Delete Empty Layers ::"

End Sub


Public Sub DelEmptyPages()
' Deletes unused pages
If ActiveDocument Is Nothing Then End

Dim p As Page, i As Integer
i = 0

For Each p In ActiveDocument.Pages
   If ActivePage.Shapes.Count = 0 Then
      If ActiveDocument.Pages.Count = 1 Then
         MsgBox "The only one page is empty, but must remain.", vbInformation, ":: Delete Empty Pages ::"
      Else
         p.Delete
         i = i + 1
      End If
   End If
Next p

If i > 0 Then MsgBox i & " empty pages deleted.", vbInformation, ":: Delete Empty Pages ::"
      
End Sub
Reply With Quote
  #6  
Old 28-08-2005, 03:35
petig
Guest
 
Posts: n/a
Default

First I thank all the zero reply in the last month. I think it means, everything is well. But I have a little problem, if anyone can help, please do it!
I tried to take the LastShapeLayerActivate macro code into the GlobalDocument_SelectionChanged event, but unfortunately, that get the shape what was selected *before* the newly clicked object. If I do anything with that shape (e.g. query the unice ID with a message box), after that the new shape will be referenced. Also, this event is raise if selection move or get transformation (in CD11). What did I wrong? There is any way to trigger activation of the layer of the last selected object automaticaly? It causes a lot of problem and extra watching (and lost time) for me the grouping moves the shapes to the active layer instead of any grouped shape's layer...
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
CorelDraw 10 DXF export relative coordinates - VBA solution? asb617 CorelDRAW/Corel DESIGNER VBA 2 01-04-2010 03:34
Send to layers click101 CorelDRAW/Corel DESIGNER VBA 4 14-09-2004 03:46
File Converter - turning off layers venturian CorelDRAW/Corel DESIGNER VBA 6 27-01-2004 09:08
Looping layers: Why doesn't this work? andyb CorelDRAW/Corel DESIGNER VBA 1 10-07-2003 19:41
Keeping the stacking order when changing layers Rick Randall CorelDRAW/Corel DESIGNER VBA 1 04-02-2003 23:34


All times are GMT -5. The time now is 11:20.


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