![]() |
#1
|
|||
|
|||
![]()
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 |
#2
|
|||
|
|||
![]()
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 |
#3
|
||||
|
||||
![]()
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 |
#4
|
|||
|
|||
![]()
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 Last edited by petig; 21-07-2005 at 16:40. |
#5
|
|||
|
|||
![]()
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 |
#6
|
|||
|
|||
![]()
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... |
![]() |
Currently Active Users Viewing This Thread: 1 (0 members and 1 guests) | |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
CorelDraw 10 DXF export relative coordinates - VBA solution? | asb617 | CorelDRAW/Corel DESIGNER VBA | 2 | 01-04-2010 02:34 |
Send to layers | click101 | CorelDRAW/Corel DESIGNER VBA | 4 | 14-09-2004 02:46 |
File Converter - turning off layers | venturian | CorelDRAW/Corel DESIGNER VBA | 6 | 27-01-2004 08:08 |
Looping layers: Why doesn't this work? | andyb | CorelDRAW/Corel DESIGNER VBA | 1 | 10-07-2003 18:41 |
Keeping the stacking order when changing layers | Rick Randall | CorelDRAW/Corel DESIGNER VBA | 1 | 04-02-2003 22:34 |