cdrTraceLineDrawing FAILS, producing single linear path instead of Centerline bitmap trace?

community.coreldraw.com/.../tracesettings.color
API Documentation > CorelDRAW > 2017 > TraceSettings > IVGTraceSettings
TraceSettings.Color property
Returns the given color from the generated color palette

Syntax:
__declspec(property(get=GetColor)) IVGColorPtr Color[];
IVGColorPtr GetColor(int Index);

Parameters:
Name    Type    Description
Index     int        Specifies the color by its index number


community.coreldraw.com/.../tracesettings.paletteid
API Documentation > CorelDRAW > 2017 > TraceSettings > IVGTraceSettings
TraceSettings.PaletteID property
Specifies the fixed palette to use if spot color mode is selected

Syntax:
__declspec(property(get=GetPaletteID)) cdrPaletteID PaletteID;
cdrPaletteID GetPaletteID();


community.coreldraw.com/.../palettemanager.getpalette
API Documentation > CorelDRAW > 2017 > PaletteManager > IVGPaletteManager
PaletteManager.GetPalette method
Returns a specified palette identified by an index, unique ID, name, or file name

Syntax:
Palette GetPalette(object IndexOrName);

Parameters:
Name                  Type     Description
IndexOrName     object    Specifies the item by its index number or name:



community.coreldraw.com/.../is-there-a-macro-to-label-colors
Mek over 6 years ago

    Myron said:
    Would be great if I could just marquee select them all and hit a macro to automatically label them.

Sub LabelSwatches()
        Dim sr As ShapeRange, sh As Shape, cn As Shape, col As Color
        ActiveDocument.Unit = cdrInch
        Set sr = ActiveSelectionRange
        If sr.Count = 0 Then MsgBox "Nothing selected!": Exit Sub
           ActiveDocument.BeginCommandGroup "ColorsNames"
           For Each sh In sr
                     Set col = sh.Fill.UniformColor
                     Set cn = ActiveDocument.ActiveLayer.CreateArtisticText(sh.CenterX, sh.CenterY + (sh.SizeHeight / 2.5), col.Name & vbCr & col.Name(True), cdrEnglishUS, , "Arial", sh.SizeWidth / 0.18, , , , cdrCenterAlignment)
                       cn.Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 0)
           Next sh
           ActiveDocument.EndCommandGroup
End Sub
 
..

community.coreldraw.com/.../coreldraw-vba-tracking-active-color-on-palette-palette_onclick

So, for example, you're working in CorelDRAW, and have VBA code that runs whenever the SelectionChange event fires (which includes selecting an item or changing its fill or outline color).
What do you want to do when that event fires?

zeegee
Offline zeegee over 1 year ago in reply to Eskimo
    ..I see how that works,. I can capture the color being selected from the palette.

Eskimo over 1 year ago in reply to zeegee
When I do that sort of thing, I usually have something like this in "ThisMacroStorage":

Private Sub GlobalMacroStorage_SelectionChange()
    check_selection
End Sub

'and then have it call a sub in another module in the project:

Sub check_selection()
    Dim sr As ShapeRange
    Dim s As Shape
    Dim colorThis As Color
    Dim strObjDataName As String

        If Not ActiveDocument Is Nothing Then
           If ActiveSelectionRange.Count = 1 Then
              Set s = ActiveSelectionRange(1)
              If s.Type = cdrCurveShape Then
                 If s.Fill.Type = cdrUniformFill Then
                      Set colorThis = s.Fill.UniformColor
                    strObjDataName = s.ObjectData("Name")
                    Debug.Print "Object Data Name: " & strObjDataName
                    Debug.Print "Color name: " & colorThis.Name
                 End If
              End If
           End If
        End If
End Sub

Offline zeegee over 1 year ago in reply to zeegee
My end goal with this is to have a button for the user (manager role) to click so they could change a palette color name or associate another piece of data with that particular palette color. I will probably add some code if I don't have an active page to open a new document.

Global glbStatusBarColor As String

Then this sub getting called from the GlobalMacroStorage_SelectionChange
Public Sub PaletteColorCheck()
       Dim pal As Palette
       Dim col As Color
       If ActiveSelection.Shapes.Count = 0 And glbStatusBarcolor = "" Then
          ActivePage.ActiveLayer.CreateRectangle 325, 240, 150, 40
          glbStatusBarcolor = ActiveSelection.Fill.UniformColor.name
           Debug.Print glbStatusBarcolor
           ActiveSelection.Delete
       Else
            glbStatusBarcolor = ""
       End If


community.coreldraw.com/.../vba-get-a-color-value
Mek over 4 years ago
You can try following code
Sub test()
Dim s As Shape
Dim value As String, os As ShapeRange
Set os = ActiveSelectionRange
If os.Count < 1 Then MsgBox ("Nothing selected!"): Exit Sub
   For Each s In os
           value = s.Fill.UniformColor.ToString
           value1 = s.Fill.UniformColor.Name
           MsgBox (value & vbCr & value1)
   Next s
End Sub

..hi Joe, i've also found the following Event Handlers which i'm attempting to hook within\after Bitmap.Trace to merge reduced colors. I'm hoping you may please do the same if event handlers are applicable. As always appreciate any solutions or suggestions.
Jeff


community.coreldraw.com/.../8-6---working-with-shapes
Class         Member                 Description
AddinHook     ShapeCreated event     Is triggered when a shape is created For more information, see Creating shapes.

Application     SelectionChange event     Is triggered when a selection is deactivated For more information, see Deselecting shapes.

Document     SelectionChange event     Is triggered when a selection is deactivated For more information, see Deselecting shapes.

Document     ShapeChange event     Is triggered when a shape is deselected For more information, see Deselecting shapes.
Document     ShapeCreate event     Is triggered when a shape is created For more information, see Creating shapes.
Document     ShapeDelete event         Is triggered when a shape is deleted For more information, see Deleting shapes.
Document     ShapeDistort event         Is triggered when a shape is distorted For more information, see Applying distortions.
Document     ShapeMove event         Is triggered when a shape is positioned For more information, see Positioning shapes.
Document     ShapeTransform event     Is triggered when a shape is transformed For more information, see Transforming shapes.

GlobalMacroStorage     SelectionChange event     Is triggered when a selection is deactivated For more information, see Deselecting shapes.


forums.codeguru.com/showthread.php
April 21st, 2004, 07:43 AM #5
Aleksan is offline Junior Member
Join Date    Jan 2004
Posts    8    

In Basic its look like this

Dim Draw As CorelDRAW.Application
Dim WithEvents MyAddin As CorelDRAW.AddinHook

Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As                                     AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)
                Set Draw = Application
                Set MyAddin = Draw.AddIns.Attach(cdrAddinFilterNone, "Get Shape Length")
End Sub

Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
                     Set GetLengthAddin = Nothing
                     Set Draw = Nothing
End Sub

Private Sub GetLengthAddin_Execute()
End Sub



www.oberonplace.com/.../comaddins.htm
..11. Add the code to OnConnection and OnDisconnection event handlers. Use the following example on how to do this:

Dim Draw As CorelDRAW.Application
Dim WithEvents CropMarksAddin As CorelDRAW.AddinHook

Private Sub AddinInstance_OnConnection(ByVal Application As Object, _
             ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, _
             ByVal AddInInst As Object, custom() As Variant)
             Set Draw = Application
             Set CropMarksAddin = Draw.AddIns.Attach(cdrAddinFilterNone, "Create &CropMarks")
End Sub

Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As _
             AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
             Set CropMarksAddin = Nothing
             Set Draw = Nothing
End Sub

In the above example, the application object is set to a global variable Draw. Then a new addin hook is added to CorelDRAW by using its Addins collection and calling its Attach method.

..13. Add the code to the Execute event handler to provide your addin code:

Private Sub CropMarksAddin_Execute()
    Dim x As Double, y As Double, sx As Double, sy As Double
    If Draw.Documents.Count > 0 Then
        If Draw.ActiveSelection.Shapes.Count > 0 Then
            Draw.ActiveSelection.GetBoundingBox x, y, sx, sy, True
            With Draw.ActiveLayer
                .CreateLineSegment x - 0.5, y, x, y
                .CreateLineSegment x, y - 0.5, x, y
                .CreateLineSegment x + sx, y, x + sx + 0.5, y
                .CreateLineSegment x + sx, y - 0.5, x + sx, y
                .CreateLineSegment x - 0.5, y + sy, x, y + sy
                .CreateLineSegment x, y + sy, x, y + sy + 0.5
                .CreateLineSegment x + sx, y + sy, x + sx + 0.5, y + sy
                .CreateLineSegment x + sx, y + sy, x + sx, y + sy + 0.5
            End With
        End If
    End If
End Sub

14. Save your project and compile in a DLL. Go to File>Make CropMarks.dll menu in Visual Basic and specify a folder to save the addin DLL to. When the addin is compiled it is automatically registered with CorelDRAW.

So now you can just launch CorelDRAW and see how it works. After CorelDRAW is started, create a new document and create a shape. With the shape still selected go to Tools>Visual Basic>Addins and choose "Create CropMarks" item in the pop-up menu. The addin should be executed and crop marks should be created around the selected shape in CorelDRAW document.

Hi Joe, no probs with delay, i recalled you'd be busy with own projects.
- I agree event handlers may leave me in same position ie: even after "hooking" Outline.trace and still having no macro access to trace Merge function.
- Also looked at "Color Styles-Merge", but think thats literal merging styles and not colors. There doesn't seem to be any other way to Merge colors\palettes in CorelDRAW. I've also looked for capable macro's or plugins, might you know of any?
- regarding using a custom palette, are you referring to Bitmap.Trace method, PaletteID &cdrCustom?, or perhaps b) to d) below(&for this 1000 frame scene and most others, i'd only need one palette=5 colors:
a)
community.coreldraw.com/.../bitmap.trace
API Documentation > Corel DESIGNER > X7 > Bitmap > IVGBitmap
Bitmap.Trace method

Function Trace(
ByVal TraceType As cdrTraceType,
Optional ByVal Smoothing As Integer = -1,
Optional ByVal DetailLevelPercent As Integer = 0,
Optional ByVal ColorMode As cdrColorType = cdrColorMixed,
Optional ByVal PaletteID As cdrPaletteID = cdrCustom,                <---
Optional ByVal ColorCount As Long = 0,) As TraceSettings

b)
community.coreldraw.com/.../palettemanager.getpalette
API Documentation > CorelDRAW > 2017 > PaletteManager > IVGPaletteManager
PaletteManager.GetPalette method
Returns a specified palette identified by an index, unique ID, name, or file name

Syntax:
Palette GetPalette(object IndexOrName);

Parameters:
Name         Type     Description
IndexOrName     object    Specifies the item by its index number or name:

Remarks:
The GetPalette method returns the specified color palette (Palette object) by index number, unique identifier, name, or filename.

c)
community.coreldraw.com/.../tracesettings.paletteid
API Documentation > CorelDRAW > 2017 > TraceSettings > IVGTraceSettings
TraceSettings.PaletteID property
Specifies the fixed palette to use if spot color mode is selected

Syntax:
__declspec(property(get=GetPaletteID)) cdrPaletteID PaletteID;
cdrPaletteID GetPaletteID();

Remarks:
The PaletteID property specifies the fixed palette to use if the spot-color mode is selected.

d)
community.coreldraw.com/.../coreldraw-vba-tracking-active-color-on-palette-palette_onclick
Private Sub GlobalMacroStorage_SelectionChange()
    check_selection
End Sub

and then have it call a sub in another module in the project:

Sub check_selection()
    Dim sr As ShapeRange
    Dim s As Shape
    Dim colorThis As Color
    Dim strObjDataName As String

        If Not ActiveDocument Is Nothing Then
           If ActiveSelectionRange.Count = 1 Then
              Set s = ActiveSelectionRange(1)
              If s.Type = cdrCurveShape Then
                 If s.Fill.Type = cdrUniformFill Then
                      Set colorThis = s.Fill.UniformColor
                    strObjDataName = s.ObjectData("Name")
                    Debug.Print "Object Data Name: " & strObjDataName
                    Debug.Print "Color name: " & colorThis.Name
                 End If
              End If
           End If
        End If
End Sub


My end goal with this is to have a button for the user (manager role) to click so they could change a palette color name or associate another piece of data with that particular palette color. I will probably add some code if I don't have an active page to open a new document.

Global glbStatusBarColor As String

Then this sub getting called from the GlobalMacroStorage_SelectionChange
Public Sub PaletteColorCheck()
       Dim pal As Palette
       Dim col As Color
       If ActiveSelection.Shapes.Count = 0 And glbStatusBarcolor = "" Then
          ActivePage.ActiveLayer.CreateRectangle 325, 240, 150, 40
          glbStatusBarcolor = ActiveSelection.Fill.UniformColor.name
          Debug.Print glbStatusBarcolor
          ActiveSelection.Delete
       Else
          glbStatusBarcolor = ""
       End If

First of all, as always, Shelby has come through by having answered an important question about color conversion to a specific palette. 

After that I could modify the current macro to trace the image and then change the colors to a custom palette. It looks like this:

Sub TraceActivePage()
    Dim BitmapToTrace As Shape, ShapesOnPage As ShapeRange, CurrentPage As Page
    
    Dim OurCustomPalette As Palette
    Dim ColorCode As Long, TempShape As Shape
    
    Set OurCustomPalette = ActiveDocument.Palette
    
    For Each CurrentPage In ActiveDocument.Pages
        CurrentPage.Activate
        Set ShapesOnPage = ActivePage.Shapes.FindShapes(, cdrBitmapShape)
        
        For Each BitmapToTrace In ShapesOnPage
            With BitmapToTrace.Bitmap.Trace(cdrTraceClipart, 10 * 2.55, 45 * 2.55, cdrColorRGB, , 256, False, , False)
                .Finish
            End With
            
            If Not ActiveSelectionRange Is Nothing Then
                ActiveSelectionRange.Group.UngroupAll
            End If
            
            Set ShapesOnPage = ActiveSelectionRange
            
            For Each TempShape In ShapesOnPage
                ColorCode = OurCustomPalette.MatchColor(TempShape.Fill.UniformColor)
                TempShape.Fill.ApplyUniformFill OurCustomPalette.Color(ColorCode)
            Next TempShape
            
            BitmapToTrace.Delete
        Next BitmapToTrace
    Next CurrentPage
End Sub

And to give you a better idea on usage I created a video: https://vimeo.com/501373471

While recording the video I had a CorelDRAW crash 13 times. There is something it does not like when the sequence of actions is not correct. So make sure you follow this exactly.

If this is what you wanted let me know and optimizations can be added so it happens basically instantly without all that selection blinking, etc.

The code is far from perfect, but it seems to do what you wanted, so hopefully that helps.