OberonPlace.com Forums  

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

Thread Tools Search this Thread Display Modes
Old 30-06-2009, 06:44
Posts: n/a
Question Please revise my code

Is it to messy?

Global box_x As Double
Global box_y As Double
Global Shape_rx As Double
Global x As Double
Global y As Double
Global x1 As Double
Global in_x As Double

Sub Bound_box()
Dim i
Dim Layer_PB As Boolean


i = 0

Do While i < ActivePage.Layers.Count
       i = i + 1
       If ActiveLayer.Name = "PB" Then
       Layer_PB = True
       End If

If Layer_PB = True Then
    Create_bx2              ' if active layer name is "PB" then we create only boxes
    Create_bx               ' if active layer name is not "PB" then we create layer
    End If

End Sub

' Create Layer PB

Function Create_bx()
    ActivePage.CreateLayer "PB"
End Function

' Activate Layer and make boxes

Function Create_bx2()
    in_x = 10
    Shape_rx = ActiveSelection.RightX
    ActiveDocument.Unit = cdrMillimeter
    ActiveDocument.ActivePage.GetSize box_x, box_y
    RL = Shape_rx
    x = Shape_rx + in_x
    y = box_y - in_x
    x1 = box_y
    ActiveLayer.CreateRectangle RL, x1, x, y, 0, 0, 0, 0
    ActiveLayer.CreateRectangle 0, 0, in_x, in_x, 0, 0, 0, 0
    ActiveLayer.Shapes.All.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)
    ActiveLayer.Shapes.All.SetOutlineProperties (0)
End Function
Reply With Quote
Old 30-06-2009, 07:02
Posts: n/a

I have a problem with Shape_rx variable

Why dose it keep the same value even if i don't have any objects on the page?
Reply With Quote
Old 01-07-2009, 17:34
shelbym's Avatar
shelbym shelbym is offline
Senior Member
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,791
Blog Entries: 15
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 Slightly Differnt

Here is my slightly different version. As you will see I use a Function to look for the layer and if it can't find it creates it.
Sub Bound_box()
    Const in_x As Double = 10
    Dim srAll As ShapeRange, srBoxes As New ShapeRange
    Dim lr As Layer, doc As Document
    Dim box_x As Double, box_y As Double, Shape_rx As Double
    Dim x As Double, x1 As Double, y As Double
    Set doc = ActiveDocument
    Set srAll = doc.ActivePage.Shapes.All
    doc.Unit = cdrMillimeter
    doc.ActivePage.GetSize box_x, box_y
    Shape_rx = srAll.RightX
    x = Shape_rx + in_x
    y = box_y - in_x
    x1 = box_y
    Set lr = FindLayer(ActivePage, "PB")
    srBoxes.Add lr.CreateRectangle(Shape_rx, x1, x, y)
    srBoxes.Add lr.CreateRectangle(0, 0, in_x, in_x)
    srBoxes.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)
    srBoxes.SetOutlineProperties 0
End Sub

Function FindLayer(ByVal pg As Page, ByVal Name As String) As Layer
    Dim LayerFound As Layer
    Dim lr As Layer
    Set LayerFound = Nothing
    For Each lr In pg.Layers
        If lr.Name = Name Then
            Set LayerFound = lr
            Exit For
        End If
    Next lr
    If LayerFound Is Nothing Then
        Set LayerFound = ActivePage.CreateLayer(Name)
    End If
    Set FindLayer = LayerFound
End Function
Best of luck,

Reply With Quote
Old 02-07-2009, 00:15
Posts: n/a

Thank you for your time

Yours its much more cleaner
Reply With Quote

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
Installation code for lumiere! snobber General 0 25-09-2008 10:22
[useful code] wOxxOm CorelDRAW/Corel DESIGNER VBA 0 19-12-2007 15:00
[useful code] sortDelimitedText wOxxOm CorelDRAW/Corel DESIGNER VBA 0 19-12-2007 14:51
v11 code in v13 diwin CorelDRAW/Corel DESIGNER VBA 5 26-06-2007 18:43
Why does this code run so slow? Webster CorelDRAW/Corel DESIGNER VBA 3 20-03-2007 05:18

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

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