OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > Code Critique

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 01-09-2015, 14:45
ddonnahoe's Avatar
ddonnahoe ddonnahoe is offline
Senior Member
 
Join Date: Jan 2004
Location: Louisville, KY
Posts: 552
Send a message via ICQ to ddonnahoe Send a message via AIM to ddonnahoe Send a message via MSN to ddonnahoe Send a message via Yahoo to ddonnahoe
Default Macro for increasing and decreasing outline widths.

I created 2 sub for use in X7 that I can add shortcut keys to that will increase and decrease the outline widths of selected objects.

I'm wondering if anyone could look at my code and tell if there is anything i might do differently to streamline the code...

Code:
Sub OutlinesIncrease()
    Dim s As Shape
    
    ActiveDocument.unit = cdrPoint

    For Each s In ActiveSelection.Shapes.FindShapes()
        If s.CanHaveOutline Then
            If s.Outline.Width > 0 And s.Outline.Width < 1 Then
                s.Outline.Width = 1
            End If
            If s.Outline.Width > 1 Then
                s.Outline.Width = s.Outline.Width + 1
            End If
        End If
    Next s
End Sub

Sub OutlinesDecrease()
    Dim s As Shape
    
    ActiveDocument.unit = cdrPoint

    For Each s In ActiveSelection.Shapes.FindShapes()
        If s.CanHaveOutline Then
            If s.Outline.Width > 1 Then
                s.Outline.Width = s.Outline.Width - 1
            End If
        End If
    Next s
End Sub
__________________
Sean
Waiting for a ride in the T.A.R.D.I.S.
Reply With Quote
  #2  
Old 02-09-2015, 04:46
shark shark is offline
Senior Member
 
Join Date: Aug 2010
Location: Russia, Belgorod
Posts: 145
Default Another variant

Code:
Sub IncOutline()
Dim s As Shape
    
    ActiveDocument.Unit = cdrPoint

    For Each s In ActiveSelectionRange
        If s.CanHaveOutline Then
            With s.Outline
                .Width = .Width + 1
            End With
        End If
    Next s
End Sub

Sub DecrOutline()
Dim s As Shape
    
    ActiveDocument.Unit = cdrPoint

    For Each s In ActiveSelectionRange
        If s.CanHaveOutline Then
            With s.Outline
                If Round(.Width, 2) < 1 Then
                    .SetNoOutline
                Else
                    .Width = .Width - 1
                End If
            End With
        End If
    Next s
End Sub
Reply With Quote
  #3  
Old 02-09-2015, 07:25
ddonnahoe's Avatar
ddonnahoe ddonnahoe is offline
Senior Member
 
Join Date: Jan 2004
Location: Louisville, KY
Posts: 552
Send a message via ICQ to ddonnahoe Send a message via AIM to ddonnahoe Send a message via MSN to ddonnahoe Send a message via Yahoo to ddonnahoe
Default

Nice Shark, however this doesn't account for objects that might be grouped or selections that contain grouped items. That's why I used FindShapes().

My biggest issue now is getting Optimization to work so that it doesn't take forever to redraw if there are a lot of items selected.
__________________
Sean
Waiting for a ride in the T.A.R.D.I.S.
Reply With Quote
  #4  
Old 02-09-2015, 11:38
shark shark is offline
Senior Member
 
Join Date: Aug 2010
Location: Russia, Belgorod
Posts: 145
Default

You can use
Code:
ActiveDocument.BeginCommandGroup
Optimization = True
before For-Each and
Code:
Optimization = False
ActiveDocument.EndCommandGroup
after Next s

Last edited by shark; 02-09-2015 at 11:41.
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
Setting document outline unit from macro L_G_D CorelDRAW/Corel DESIGNER VBA 2 11-02-2010 11:47
residual outline icerat Jigsaw Puzzle Creator 2 08-01-2009 12:33
Table outline and VBA Vylda CorelDRAW/Corel DESIGNER VBA 2 24-11-2008 11:48
Need Macro for "Convert Outline to Object" billjones Macros/Add-ons 9 02-03-2006 07:36
Contour/Outline..... Anonymous General 2 01-12-2004 00:10


All times are GMT -5. The time now is 01:47.


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