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 24-01-2012, 23:33
knowbodynow knowbodynow is offline
Senior Member
 
Join Date: Mar 2006
Location: Hatsukaichi near Hiroshima
Posts: 431
Default Trim an Object by its outline

Is there an way to take a single shape and reduce its size by its own outline and in the process remove the outline? I tried this:

Code:
Sub TrimByOutline()

Dim s as shape
Dim ss as shape

If ActiveDocument Is Nothing Then Exit Sub
If ActiveShape Is Nothing Then Application.ActiveTool = cdrToolDrawFreehand
 
    Set s = ActiveShape
    
    Set ss = s.Outline.ConvertToObject

ActiveDocument.ClearSelection

ss.CreateSelection
s.AddToSelection

ss.Trim s

ss.Delete


End Sub
The results are hit and miss. Sometimes the middle of my original shape disappears and I just have a thinner outline. Is there a more foolproof method. Thanks
Reply With Quote
  #2  
Old 25-01-2012, 01:03
Sablesword Sablesword is offline
Junior Member
 
Join Date: Aug 2006
Posts: 20
Default

I have an old, much-used macro that creates a duplicate shape equal to the outline of the selected shape. A little tweaking of that code gives me this:

Code:
Sub shrink_by_outline()
Dim OrigSelection As ShapeRange
Dim dup1 As ShapeRange
Dim s1 As Shape, s2 As Shape
If ActiveSelection.Shapes.Count = 0 Then
    MsgBox "Please select an object.", vbOKOnly
    Exit Sub
ElseIf ActiveSelection.Shapes.Count > 1 Then
    MsgBox "Please select only one object.", vbOKOnly
    Exit Sub
ElseIf ActiveSelection.Shapes.Count = 1 Then
    Set OrigSelection = ActiveSelectionRange
End If
Set s1 = OrigSelection.FirstShape
If s1.Type <> cdrCurveShape Then
   s1.ConvertToCurves
End If
If s1.Curve.Closed Then
Set dup1 = OrigSelection.Duplicate()
    dup1.SetOutlineProperties Color:=CreateRGBColor(0, 255, 0)
    Set s2 = dup1(1).Outline.ConvertToObject
    dup1.Delete
    s1.Outline.SetNoOutline
    s2.Trim s1
    s2.Delete
Else
    MsgBox "please close shape", vbOKOnly
End If
End Sub
Reply With Quote
  #3  
Old 25-01-2012, 07:54
knowbodynow knowbodynow is offline
Senior Member
 
Join Date: Mar 2006
Location: Hatsukaichi near Hiroshima
Posts: 431
Default

Fantastic! It works exactly as I was trying to achieve. Thank you very much.

Best wishes,

Chris
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
"Convert Outline To Object" Problem billjones General 5 30-04-2006 07:29
Need Macro for "Convert Outline to Object" billjones Macros/Add-ons 9 02-03-2006 07:36
How to get the size of an object including the outline. CORNMEN CorelDRAW/Corel DESIGNER VBA 2 03-05-2005 16:03
Contour/Outline..... Anonymous General 2 01-12-2004 00:10
Bounding with Outline Hernán CorelDRAW/Corel DESIGNER VBA 1 31-07-2003 13:43


All times are GMT -5. The time now is 03:29.


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