Hello esteemed CDR &CorelDESIGNER API Members, and thanks for such excellent programming, scripts and productive support.1) I hoped you might please advise how to use cdrTraceType cdrTraceLineDrawing which FAILS, only producing a single linear path instead of CENTERLINE trace?When using cdrTraceLineArt the same macros below WORK, producing vectorized OUTLINE paths from bitmap textures:(please feel free to forward this to anyone who may instruct remedy. Thanks for any help, Jeff)(2) Bitmap Trace via With(reference) to ActivePage Shapes:Sub TraceActivePage() Dim s As Shape, sr As ShapeRange, p As Page For Each p In ActiveDocument.Pages p.Activate Set sr = ActivePage.Shapes.FindShapes(, cdrBitmapShape) Set s = ActiveShape For Each s In sr With s.Bitmap.Trace(cdrTraceLineDrawing, 25, 100, cdrColorBlackAndWhite, cdrUniform, , True, True, True) .Finish End With Next s Next pEnd Sub(1) Bitmap Trace via Set(parameter) TraceSettings:Sub TraceSettings()Dim s As Shape, sr As ShapeRangeDim t As TraceSettingsFor Each s In ActivePage.FindShapes(, cdrBitmapShape) Set t = s.Bitmap.Trace(cdrTraceLineDrawing, 25, 100, cdrColorBlackAndWhite, cdrUniform, , True, True, True) t.Finish Next s Set t = Nothing Set s = NothingEnd Sub
Hello, already in the New Year.
Could you make a visual example of what is not working/what you would like to achieve? Because on my side running the scripts seems to work as needed, making center line traced outline objects...
Hi Joe, Happier New Year, really appreciate your reply and confirmation the scripts work on your system and CorelDRAW version.I assume you ran the scripts as is, or please let know of any changes?2) please confirm you substituted cdrTraceLineDrawing in place of cdrTraceLineArt in the scripts?, and did cdrTraceLineDrawing work?,3) please let know which version of CorelDRAW, and on what system your successfully running the cdrTraceLineDrawing script?, (i'm using Win7 &i tried to list complete system configs below, but the "Brand" names we're apparently flagged as advertisements)..Screenshot "1_.." is a frame 572 of project footage,screenshot 1a_, is Manual Bitmaps > Centerline trace > Line Drawing results,screenshot 1b_, is Manual centerline trace Curve results,screenshot 2_, is script 2), function TraceSettings used with working cdrTraceLineArt enumerator,screenshot 3_, is TraceSetting script Successful results bitmap tracing Outlines,screenshot 4_, is TraceSetting script Failure with cdrTraceLineDrawing, producing only linear path instead of bitmap tracing Centerlines.I plan to achieve a script that converts each CDR bitmap-Layer to a Centerline Trace, Line Drawing.Look forward to talk soon,thx again,Jeff
Hi Joe, happy confirming the scripts are now producing Centerlines, but not near as many as manually produced(Image 1b), and mainly in the blank(black) area's as if ignoring color information.see screenshots:6.jpg = my scripts producing only 5 curves7.jpg = your script producing only 2 curves8.jpg = my script, with curves UNgrouped.Regardless of Detail, Smoothing &CornerSmoothing settings, Trace scripts will produce no more than 3 - 5 curves only in black areas, unlike correct results when manually centerline traced.5) are your Trace script results like my manual results in screenshots 1a-1b.jpg?, might you send a screenshot please?Thanks again for any suggestions or solutions,Jeff
Actually, hold on!
The settings my be acting weird in the macro, but also we need to keep in mind that the percentages we perceive as (0-100) are, apparently, byte values when using macro - so they go 0-255 not 0-100.
If we keep that in mind and convert the values like this:
Sub TraceActivePage() Dim s As Shape, sr As ShapeRange, p As Page For Each p In ActiveDocument.Pages p.Activate Set sr = ActivePage.Shapes.FindShapes(, cdrBitmapShape) Set s = ActiveShape For Each s In sr With s.Bitmap.Trace(cdrTraceLineDrawing, 80 * 2.55, 45 * 2.55, , , 2, False, , True) .Finish End With Next s Next p End Sub
The results look much closer to what you have by hand.
Hopefully this helps a little.
That's brilliance, thanks Joe. This helps Corel far more than a little and just me, since this flaw affects All VBA scripting with equivalent undocumented, catastrophic, byte value range conversions. Corel should be made aware and desperate to correct this oversight preventing clients effectively scripting\automating entirety of CorelDRAW\PHOTOPAINT. Look forward to running your latest macro, greatly appreciated!6) you suggested 'playing with threshold, is that same as Detail level, or is there an actual "Threshold" setting to edit?,7) in your Detail level .gif, centerlines were rendered starting at value:104, but then with No variation in detail at any further increased level. So macro settings edits seem again to have only partial effect\control over tracing renders compared to full control manually tracing?8) was ShapeToTrace.Bitmap.ConvertToBW cdrRenderLineArt, 100, 24 the b/w bitmap method you used to find the best settings?, if not please show which?9) attached screenshots 9-10.jpg show ArtCAM's ColorReduction then Create Centerline applied to "Disconnected open vectors"(=vertical centerlines), then successfully to "Closed vector loops"(=lateral centerlines) respectively. Can this or equivalent method be applied in CorelDRAW macro to prevent the Vertical centerlines in your sceenshot results of latest macro?..Corel owe's you big illuminating\resolving These issues alone, and since indispensable to scripting they don't support, you should obvously be on payroll.Look forward to next soonest,U da Man Joe,thx,Jeff
dancemanjc said:6) you suggested 'playing with threshold, is that same as Detail level, or is there an actual "Threshold" setting to edit?,
That is the exact name of the setting of that two color Bitmap conversion. But probably isn't important anymore, given the different approach below.
dancemanjc said:7) in your Detail level .gif, centerlines were rendered starting at value:104, but then with No variation in detail at any further increased level. So macro settings edits seem again to have only partial effect\control over tracing renders compared to full control manually tracing?
It is that function working incorrectly when used in a macro, yes. At least as far as I can tell. Nothing changes when changing the same settings that do something when using it through the user interface. So sounds like a bug to me.
dancemanjc said:8) was ShapeToTrace.Bitmap.ConvertToBW cdrRenderLineArt, 100, 24 the b/w bitmap method you used to find the best settings?, if not please show which?
Yes, that is exactly it. If you want to see how things work inside a macro you can run it step by step instead of the usual run command. Just place the cursor inside the macro text and press F8 on the keyboard to start. Then keep on pressing F8 to go through each line and see what it does. You can also just stop the macro to leave the results at that stage.
dancemanjc said:..Corel owe's you big illuminating\resolving These issues alone, and since indispensable to scripting they don't support, you should obvously be on payroll.
I wouldn't say so. There are some REALLY talented macro wizards here. Now they deserve some real praise. But it's been a little quiet here lately so I came to help to the best of my ability
dancemanjc said:Hopefully you've still a bit of time to script this additional algorithm into 'lines of needed functions achieved using a macro?,
Sub TraceActivePage() Dim S As Shape, sr As ShapeRange, p As Page For Each p In ActiveDocument.Pages p.Activate Set sr = ActivePage.Shapes.FindShapes(, cdrBitmapShape) Set S = ActiveShape For Each S In sr 'Bitmaps > Outline Trace > Line Art \ Colors(tab): Number of Colors=8, With S.Bitmap.Trace(cdrTraceClipart, 10 * 2.55, 45 * 2.55, cdrColorRGB, , 8, False, , False) .Finish End With 'The 25 at the end here makes sense if your canvas size is about 2000mm wide. 'If not you will have to adjust it so the bitmap isn't huge, but still has 'enough detail. I would just adjust the document and image to, say 1920x1080 mm. Set S = ActiveSelection.ConvertToBitmap(, , , , 25) 'Bitmaps > Centerline Trace > Line Drawing With S.Bitmap.Trace(cdrTraceLineDrawing, 80 * 2.55, 45 * 2.55, , , 2, False, , True) .Finish End With 'Remove the middle temporary image object S.Delete Next S Next p End Sub
I think that should do the things you mentioned in that list. The results are a little different from the example, but you can try changing the settings around to change the results a little.
Good luck, let me know how it goes.
..as promised here's results of Manual color-reduction\Merge as final scripting algorithm: 8 colors ordered 1 - 8 top to bottomscreenshot 11-12.jpg = Select palette colors 5+6(of 8), Merge(button)screenshot 13-14.jpg = Select palette colors 1+5(of 7), Mergescreenshot 15-16.jpg = Select palette colors 4+5(of 6), Mergescreenshot 17-18.jpg = "TraceEachPage" results rendering perimeter landscape centerlines only, No raptors\TRex centerlines i assume due to ConvertToBW the source image...Thanks again Joe,talk soon,Jeff
Hello again.
Did try using the latest code I posted above - the one that omits the b/w conversion?
Also, I tried and tried, but could not add specific colors using macro code. The parameters can only be changed once the tracing has taken place, but then it seems to be set in stone...
That may be something to ask in a separate topic (which I will most likely do). If there was a way to do that your main task should basically be achievable in a macro.
Morning Joe, i to found limited to no methods or properties for the Bitmaps > Outline Trace > Line Art \ Colors(tab):MERGE(button). Sofar found only MergeAdjacentObjects(on by default) &dissimilar from Merge, and cdrMergeColor RE:according to script editors "ctrl+j", it is substituted as cdrTraceType ie: s.Bitmap.Trace(cdrMergeColor, , , , ,)AND,.community.coreldraw.com/.../cdrmergemodecdrMergeMode enumerationSyntax:enum VGCore.cdrMergeMode : int;Members:Name Value Description*cdrMergeColor 14 Specifies Color modeVersion Information:CorelDRAW: X7.4, X7, X7.6, X8, 2017, 2018, 2019, 2019.2, 2020Corel PHOTO-PAINT: X7.4, X7, X7.6, X8, 2017, 2018, 2019, 2019.2, 2020Corel DESIGNER: X7, 2017.1, 20.1, 2019.2..but can find No full syntax or usage example macros online or in any docs.11) are you familiar with and could show use of cdrMergeColor if applicable?,..thanks for posting "Is there a way to change the colors when tracing something via code?", really hope there's a way to script the last step in this powerful process.Look forward to trying your new TraceActivePage.Thanks again for your enlightening diagnostics and instruction,Jeff
Hi Joe, while searching for any examples merging colors within trace, i'd found the following TraceSettings.Palette specifications and macro segments which with your experience may determine more quickly than i their applicability and possible implementation. Hope helpful, thx again for yours, Jeff.
community.coreldraw.com/.../tracesettings.colorAPI Documentation > CorelDRAW > 2017 > TraceSettings > IVGTraceSettingsTraceSettings.Color propertyReturns the given color from the generated color paletteSyntax:__declspec(property(get=GetColor)) IVGColorPtr Color[];IVGColorPtr GetColor(int Index);Parameters:Name Type DescriptionIndex int Specifies the color by its index numbercommunity.coreldraw.com/.../tracesettings.paletteidAPI Documentation > CorelDRAW > 2017 > TraceSettings > IVGTraceSettingsTraceSettings.PaletteID propertySpecifies the fixed palette to use if spot color mode is selectedSyntax:__declspec(property(get=GetPaletteID)) cdrPaletteID PaletteID;cdrPaletteID GetPaletteID();community.coreldraw.com/.../palettemanager.getpaletteAPI Documentation > CorelDRAW > 2017 > PaletteManager > IVGPaletteManagerPaletteManager.GetPalette methodReturns a specified palette identified by an index, unique ID, name, or file nameSyntax:Palette GetPalette(object IndexOrName);Parameters:Name Type DescriptionIndexOrName object Specifies the item by its index number or name:community.coreldraw.com/.../is-there-a-macro-to-label-colorsMek 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.EndCommandGroupEnd 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?zeegeeOffline 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 zeegeeWhen I do that sort of thing, I usually have something like this in "ThisMacroStorage":Private Sub GlobalMacroStorage_SelectionChange() check_selectionEnd 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 IfEnd Sub
Offline zeegee over 1 year ago in reply to zeegeeMy 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 StringThen this sub getting called from the GlobalMacroStorage_SelectionChangePublic 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 Ifcommunity.coreldraw.com/.../vba-get-a-color-valueMek over 4 years agoYou can try following codeSub test()Dim s As ShapeDim value As String, os As ShapeRangeSet os = ActiveSelectionRangeIf 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 sEnd 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.Jeffcommunity.coreldraw.com/.../8-6---working-with-shapesClass Member DescriptionAddinHook 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.phpApril 21st, 2004, 07:43 AM #5Aleksan is offline Junior MemberJoin Date Jan 2004Posts 8 In Basic its look like thisDim Draw As CorelDRAW.ApplicationDim WithEvents MyAddin As CorelDRAW.AddinHookPrivate 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 SubPrivate Sub AddinInstance_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant) Set GetLengthAddin = Nothing Set Draw = NothingEnd SubPrivate Sub GetLengthAddin_Execute()End Subwww.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.ApplicationDim WithEvents CropMarksAddin As CorelDRAW.AddinHookPrivate 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 SubPrivate Sub AddinInstance_OnDisconnection(ByVal RemoveMode As _ AddInDesignerObjects.ext_DisconnectMode, custom() As Variant) Set CropMarksAddin = Nothing Set Draw = NothingEnd SubIn 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 IfEnd Sub14. 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.
Hello again! Sorry for the delay, was busy with some work related stuff.
Anyhow, see you have been busy as well. I am not 100% sure the event handlers would help, but will try to have a look.
I had to look at certain things that would have to deal with proper user windows for a task I am currently working on and, frankly, not sure if it is actually possible to access that type of interaction via a macro. Will try to look a little harder, though.
One thing that seemed promising for your case from the things you quoted above is using a custom palette. Perhaps it would be possible to make a palette that suits your needs and then attempt to use that when tracing via macro.
But that would be fairly limited to a single scene and you may need a lot of those palettes?