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 14-10-2005, 14:28
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 Create Dimensions via VBA

I have this little bit of code that I started...
Code:
Sub Dimensions()
    Dim p As Page
    Dim doc As Document
    Dim x As Double, y As Double
    Dim w As Double, h As Double
    Dim sr As ShapeRange
    Dim s As Shape
    
    Set sr = ActivePage.Shapes.All
    sr.GetBoundingBox x, y, w, h
    ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, x, y, True, , , cdrDimensionStyleDecimal, 2, True, cdrDimensionUnitIN, cdrDimensionWithinLine, True, False, False, , , 5, , , technical, ts) = 0
End Sub
But when I get to the CreateLinearDimension I get all screwed up. What I'm trying to accomplish (since there is no recording of this command or examples of it's use in the documentation) is take the bounding box of all items on the page and create dimension lines for its Width and Height.

For example, I have a 3'x5' flag, I want the code to create a dimension line on the left of the bounding box that shows 36" and one on top that shows 60". Later on I will add more functionality to the macro, like adding a dialog that allows the user to enter custom prefix, suffix, or change units of measure.

Is there anyone out there that can help with this? I know Alex is really busy right now, so anybody, please. The boss is on me to get this underway.
__________________
Sean
Waiting for a ride in the T.A.R.D.I.S.
Reply With Quote
  #2  
Old 14-10-2005, 14:52
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default

Here is an example:

Code:
Sub MakeDimensions()
    Dim x As Double, y As Double, sx As Double, sy As Double
    Dim pt1 As SnapPoint, pt2 As SnapPoint
    Dim s As Shape
    
    ActiveSelection.GetBoundingBox x, y, sx, sy
    Set pt1 = CreateSnapPoint(x, y)
    Set pt2 = CreateSnapPoint(x + sx, y)
    Set s = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pt1, pt2, True, , , cdrDimensionStyleDecimal, Units:=cdrDimensionUnitIN)
    s.Dimension.TextShape.SetPosition x + sx / 2, y - 1

    Set pt1 = CreateSnapPoint(x + sx, y)
    Set pt2 = CreateSnapPoint(x + sx, y + sy)
    Set s = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pt1, pt2, True, , , cdrDimensionStyleDecimal, Units:=cdrDimensionUnitIN)
    s.Dimension.TextShape.SetPosition x + sx + 1, y + sx / 2
End Sub
Dimensions aren't the easiest thing to work with and not the most reliable, but still works (sometimes ).

Or it might be easier to create your own dimensions using lines and text shapes with your macro. This way you can control exactly how it looks and what it shows...
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
Recreating curves in VBA code Alex CorelDRAW/Corel DESIGNER VBA 19 05-03-2011 20:37
Create Barcode from VBA b_repplinger CorelDRAW/Corel DESIGNER VBA 6 09-10-2005 17:44
Can I create CustomShape with VBA for CD? Can I create tool? Jab CorelDRAW/Corel DESIGNER VBA 0 01-02-2005 05:02
CD 10, VBA not returning true outline width Webster CorelDRAW/Corel DESIGNER VBA 1 24-11-2004 17:09
Create text in PP with VBA adriano Corel Photo-Paint VBA 1 07-01-2003 17:09


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


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