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 29-01-2015, 10:39
PAnderson PAnderson is offline
Member
 
Join Date: Nov 2003
Posts: 47
Default Artistic Media Break Apart & Delete curve

I am trying to figure out how to write a macro to break apart Artistic Media image lists -- leaving the image objects, but deleting the original control curve/outlines. For example I made a single dot AM image list and I use it as stippling for shading. I would like to be able to leave my stippling and remove the "stroke." You can imagine that if I created a dense area of dots (e.g. look at it in wire frame mode), there is an equal amount of control curves. I want to break them apart and delete those stroke curves.

Help??
Patti
Reply With Quote
  #2  
Old 29-01-2015, 12:01
PAnderson PAnderson is offline
Member
 
Join Date: Nov 2003
Posts: 47
Default

After some searching I actually found a macro posted by "Mo" for free on the CorelDRAW Community forums. He wrote it for X4 in 2008, but it still works in X7!

However, it does run a bit slow, but I don't know if that's due to the large number of AM strokes, or the age of the macro. Maybe someone (Shelby?) could take a look and see if there is anything that can be added to update it.

HTML Code:
Sub ArtistBrushBreak()
    '
    ' Scripted by mo 19.07.2008 (Version for Draw12 and X3)
    ' Updated by mo 24.07.2008 (Version includes X4)
    '
    ' Description: Breaks ArtisticMedia strokes apart
    '
    ' It is strictly recommended that the Arstistic Media Brushes should be drawn on a separate Layer!
    ' Please ungroup all Shapes on that Layer, otherwise they will be DELETED!
    
ActiveDocument.BeginCommandGroup "Brush Break"
On Error GoTo ErrHandler
    Dim sr As Shape, origSel As New ShapeRange, s As Shape
    On Error Resume Next
        For Each sr In ActiveLayer.Shapes
        If sr.Type = cdrArtisticMediaGroupShape Then
 
            origSel.Add sr
            origSel.CreateSelection
            ActiveSelection.Separate
             
        Else
    End If
 Next
    ActiveLayer.FindShapes(Type:=cdrCurveShape).CreateSelection
        For Each s In ActiveSelection.Shapes
        ' Deletes ALL open Curves on the Active Layer!
        If s.Curve.Closed = False Then
        s.Delete
        Else
        End If
Next
ExitSub:
 ActiveDocument.EndCommandGroup
 ActiveDocument.ClearSelection
 Exit Sub
 Optimization = True
    ActiveWindow.Refresh
    Application.Refresh
    
ErrHandler:
 MsgBox "Error occured: " & Err.Description
 Resume ExitSub
End Sub
Reply With Quote
  #3  
Old 29-01-2015, 12:15
PAnderson PAnderson is offline
Member
 
Join Date: Nov 2003
Posts: 47
Default

Attached is a screen shot image from WireFrame view of a blob of stippling dots before & after running macro. Nice! My only fear is that if I have a lot of this stippling on a page, that CDX7 is going to croak before it can process everything.

Patti
Attached Images
 
Reply With Quote
  #4  
Old 29-01-2015, 19:15
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,782
Blog Entries: 11
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 Artistic Media

Patti,

Is your .cdr file small enough to post here? I would like to try it and see if I can optimize things a bit.

-Shelby
Reply With Quote
  #5  
Old 29-01-2015, 19:27
PAnderson PAnderson is offline
Member
 
Join Date: Nov 2003
Posts: 47
Default

Here's a sample .cdr file. The AM stipple dots are on a separate layer.

TIA
Patti
Attached Files
File Type: cdr stipplesample.cdr (123.5 KB, 214 views)
Reply With Quote
  #6  
Old 30-01-2015, 23:17
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,782
Blog Entries: 11
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 Artistic Media

Patti,

I took your sample file and duplicated the artistic media twice so I had a total of three sets or 102 objects. This gave me a good baseline to test speed. With the macro you posted it would take about 40 - 45 seconds to remove all the control paths.

With my version that I will post below I have this time down to about .045 seconds. Mileage will vary of course depending on your CPU, RAM, and if you are 64-bit. But it should be a little quicker. ;-)

Code:
Sub ClearPathArtisticMedia()
    Dim s As Shape
    Dim sr As ShapeRange, srControlPath As New ShapeRange

    Optimization = True
    ActiveDocument.BeginCommandGroup "Clear Artistic Media Paths"
    EventsEnabled = False
    ActiveDocument.SaveSettings
    ActiveDocument.PreserveSelection = False
    On Error GoTo ErrHandler
    
        Set sr = ActiveSelectionRange.Shapes.FindShapes(, cdrArtisticMediaGroupShape)
        
        For Each s In sr
            srControlPath.Add s.Previous
            s.Separate
        Next s
        
        srControlPath.Delete
   
ExitSub:
    ActiveDocument.PreserveSelection = True
    ActiveDocument.RestoreSettings
    EventsEnabled = True
    Optimization = False
    ActiveDocument.ClearSelection
    ActiveWindow.Refresh
    Application.Refresh
    ActiveDocument.EndCommandGroup
    Exit Sub

ErrHandler:
    MsgBox "Error occured: " & Err.Description
    Resume ExitSub
End Sub
For fun I did, 30 sets or 1020 objects and it took about 1.26 seconds. ;-)

Hopefully that helps,

-Shelby

Last edited by shelbym; 30-01-2015 at 23:23.
Reply With Quote
  #7  
Old 31-01-2015, 11:57
PAnderson PAnderson is offline
Member
 
Join Date: Nov 2003
Posts: 47
Default

Amazing! I blinked and it was done. Tried a whole page of the stippling strokes, super fast, no problems. You da man, Shelby.

I like the idea that it's based on selection, instead of any open curve on a layer. That should avoid any unwanted deleting, plus sometimes I apply the stipple dots to closed shapes. This greatly reduces the file size too.

You should put this up on macromonster.com (maybe w/ an added option to choose by selection, page or document). I know there are users who like to paint with vectors, this would be very helpful!

I'm going to study this code and see if I can learn anything. I may come back with a question or two...
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
Artistic Media VBA work-around? noj CorelDRAW/Corel DESIGNER VBA 4 14-10-2011 07:40
Artistic Media Group Issue goisender Macros/Add-ons 17 09-02-2010 16:41
Artistic Media Groups And VBA knowbodynow CorelDRAW/Corel DESIGNER VBA 2 08-05-2008 22:18
Change brush in Artistic Media Tool dizzzy Macros/Add-ons 1 23-06-2007 09:21
macro for break curve and join curve mgmcs Macros/Add-ons 2 26-05-2006 22:01


All times are GMT -5. The time now is 15:26.


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