OberonPlace.com Forums

OberonPlace.com Forums (http://forum.oberonplace.com/index.php)
-   Macros/Add-ons (http://forum.oberonplace.com/forumdisplay.php?f=21)
-   -   Document Colors (http://forum.oberonplace.com/showthread.php?t=24810)

mtracy 10-05-2018 18:07

Document Colors
 
How can I reset the document colors with a macro?

I can cycle it on/off but can't figure out how to "reset" it. Once a color shape is deleted the doc palette still shows the color until you click thru and hit reset.

Sub RefreshDocPalette()
ActiveDocument.Palette.Close

ActiveDocument.Palette.Open

End Sub

P.s. why after hitting "reset palette" does it add a black swatch even though there's no black used in the doc.

mtracy 10-05-2018 18:11

One suggestion is close but it deletes all the colors. As one is "doodling" lots of colors get added to the document coors palette. Even after you delete a bunch of different colored shapes. Manually hit reset and only the colors that exist in the document are displayed.

mtracy 10-05-2018 18:11

Oops, forgot to add the suggestion

For i = ActiveDocument.Palette.Colors.Count To 1 Step -1
ActiveDocument.Palette.RemoveColor (i)
Next i

shark 18-05-2018 06:31

Hi
If you programmatically delete shape then you can check if there are any other objects of the same color left. And then delete this color from palette

mtracy 23-05-2018 15:13

I've experimented with several scripts but can't seem to get it?

shark 24-05-2018 05:05

delete color from palette
 
Code:

Sub DeleteColors()
Dim s As Shape, c As Color
    Set s = ActiveShape: If s Is Nothing Then Exit Sub
    If s.Fill.Type <> cdrUniformFill Then Exit Sub
    Set c = s.Fill.UniformColor
    s.Delete 'delete selected shape
    'looking for the same color
    For Each s In ActivePage.Shapes.All
        If s.Fill.Type = cdrUniformFill Then
            If c.IsSame(s.Fill.UniformColor) Then Exit Sub
        End If
    Next
    With ActiveDocument.Palette
        .RemoveColor .GetIndexOfColor(c)
    End With
End Sub


mtracy 24-05-2018 09:12

That actually requires you to select all the shapes and then just deletes 1 shape.

shark 28-05-2018 03:16

there is no need to select all the shapes. Macro deletes one selected shape and removes its color from the palette, if there are no more objects with the same color in current document.

if you want to delete several objects of different colors and remove their colors from the palette, then the macro needs to be slightly modified

mtracy 29-05-2018 14:34

I don't want to delete any shapes at all. I merely want the Document Colors to reflect only the colors currently used in the document. The Doc Color palette will show all colors ever used even after all shapes using that color are gone or changed.
The macro should "get color" of each shape and delete the colors from the Doc Palette that aren't currently in the doc.

shark 01-06-2018 05:03

try this:

Code:

Sub RemoveWasteColors()
Dim c As Color, sr As New ShapeRange, srAllShapes As ShapeRange, s As Shape
    Set srAllShapes = ActivePage.Shapes.All
    For Each c In ActiveDocument.Palette.Colors
        For Each s In srAllShapes
            If s.Fill.Type = cdrUniformFill Then
                If c.IsSame(s.Fill.UniformColor) Then sr.Add s
            End If
        Next s
        If sr.Count > 0 Then
            srAllShapes.RemoveRange sr: sr.RemoveAll
        Else
            With ActiveDocument.Palette
                .RemoveColor .GetIndexOfColor(c)
            End With
        End If
    Next c
End Sub


mtracy 01-06-2018 09:48

1 Attachment(s)
works but

Attachment 1240

mtracy 01-06-2018 09:49

And still has black even though nothing black exists in the doc

mtracy 01-06-2018 10:03

1 Attachment(s)
doc palette explained

Attachment 1241

shark 04-06-2018 02:52

works but
 
what version of Corel Draw do you have?

mtracy 04-06-2018 09:42

Gettin' there. Still kind of "buggy"

Seems you had to select all shapes first so I added a line after
...Set srAllShapes = ActivePage.Shapes.All
srAllShapes.AddToSelection

Would also need a
If new color found that's not already in the palette then add to palette
So if you did an undo the palette could be upadated

Error when palette is already correct and you run the macro to update. Deletes colors from the palette when it shouldn't do anything.

mtracy 08-06-2018 16:00

Nope. This one is close but doesn't work if Pantone colors are used.

Sub Reset_DocPalette()

ResetPalette ActiveDocument
End Sub

Sub ResetPalette(ByRef iDoc As Document)

Dim CurColNo As Integer, CurPg As Page, CurSh As Shape, CurSR As ShapeRange, DoIt As Boolean

For CurColNo = iDoc.Palette.Colors.Count To 1 Step -1
DoIt = True
For Each CurPg In iDoc.Pages
Set CurSR = CurPg.Shapes.All
If CurSR.Shapes.Count > 0 Then
For Each CurSh In CurSR.Shapes
'If CurSh.Fill.Type = cdrUniformFill Then CurSh.Fill.UniformColor.ConvertToCMYK
If CurSh.Fill.Type = cdrUniformFill Then

If CurSh.Fill.UniformColor.IsSame(iDoc.Palette.Colors(CurColNo)) Then DoIt = False
End If


All times are GMT -5. The time now is 05:53.

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