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 06-07-2008, 20:07
vindaa
Guest
 
Posts: n/a
Default Display in two units

In a single drawing I define some objects in meter and some in inches. So what happens is, when I am in metric mode and I select an object that is 2'6½" the status bar shows 774.7 mm. The problem is I always have to mentally convert this into inches or switch to the inch unit mode. Or when I am in inch mode the objects defined in meter defined as 156" will be displayed as 3962.4 mm (which also confuses me if it is a proper fraction or not)

So what I would like that somewhere on the status bar or wherever possible the dimension of the selected object is shown in a unit that is different then the current unit. That is when I am in inch-feet mode the status bar would show the dimension in mm and when I am in metric mode the status bar would show the dimension in inches

Is it possible?
Reply With Quote
  #2  
Old 07-07-2008, 15:43
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,770
Blog Entries: 10
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 A little time...

I have only had a little time to play with this, so my solution doesn't work 100%, but it may give you a direction. (Sorry but summer classes are just eating my time!)

I am attaching a GMS of what I have so far. The code looks like this:
Code:
Private Sub GlobalMacroStorage_SelectionChange()
    If frmUnits.Visible = True Then 'Check to see if form is running
        If ActiveSelection.Shapes.Count > 0 Then 'If there is a selection update Units
            frmUnits.UpdateUnits
        Else 'If no selection clear labels
            If frmUnits.lblWidthHeight.Caption <> "" Then frmUnits.lblWidthHeight.Caption = ""
            If frmUnits.lblCenter.Caption <> "" Then frmUnits.lblCenter.Caption = ""
        End If
    End If
End Sub
Wasn't not sure the best way to tell if the userform was running, sometimes this works, sometimes you might get an error.
Code:
Private Sub UserForm_Initialize()
    If ActiveShape Is Nothing Then
        If frmUnits.lblWidthHeight.Caption <> "" Then frmUnits.lblWidthHeight.Caption = ""
        If frmUnits.lblCenter.Caption <> "" Then frmUnits.lblCenter.Caption = ""
    Else
        UpdateUnits
    End If
End Sub

Sub UpdateUnits()
    Dim w As Double, h As Double
    Dim cx As Double, cy As Double
    
    Dim d As Document, s As Shape
    Set d = ActiveDocument
    Set s = ActiveShape
    
    If d.Rulers.HUnits = cdrInch Then
        s.GetSize w, h
        w = d.FromUnits(w, cdrMillimeter)
        h = d.FromUnits(h, cdrMillimeter)
        lblWidthHeight.Caption = "Width: " & Round(w, 3) & " mm" & " Height: " & Round(h, 3) & " mm"
        cx = s.CenterX
        cy = s.CenterY
        cx = d.FromUnits(cx, cdrMillimeter)
        cy = d.FromUnits(cy, cdrMillimeter)
        lblCenter.Caption = "Center: (" & Round(cx, 3) & " ," & Round(cy, 3) & ") millimeters"
    ElseIf d.Rulers.HUnits = cdrMillimeter Then
        s.GetSize w, h
        w = d.FromUnits(w, cdrInch)
        h = d.FromUnits(h, cdrInch)
        lblWidthHeight.Caption = "Width: " & Round(w, 3) & " in" & " Height: " & Round(h, 3) & " in"
        cx = s.CenterX
        cy = s.CenterY
        cx = d.FromUnits(cx, cdrInch)
        cy = d.FromUnits(cy, cdrInch)
        lblCenter.Caption = "Center: (" & Round(cx, 3) & " ," & Round(cy, 3) & ") inches"
    End If
End Sub
i will play with this a bit more as I have time, again hopefully it at least gets you started.

-Shelby
Attached Images
 
Attached Files
File Type: gms slm_Units.gms (34.0 KB, 11 views)
Reply With Quote
  #3  
Old 07-07-2008, 17:38
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,770
Blog Entries: 10
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 Display two units....

I seem to recall another post were you wanted to display the second unit under the first, but can't seem to find the post. So I will just add it here. Again this is really rough, needs lots of improvement, but should get you started.
Code:
Sub AddAnotherUnit()
    Dim sr As New ShapeRange
    Dim x As Double, y As Double
    Dim s As Shape, dblRotate As Double
    Dim sText As Shape, strText As String, pos As Integer
    Dim dblNew As Double
    
    ActiveDocument.ReferencePoint = cdrCenter
    
    For Each s In ActivePage.FindShapes(Type:=cdrLinearDimensionShape)
        sr.Add s.Dimension.TextShape
    Next s
    
    For Each s In sr
        strText = s.Text.Story
        pos = InStr(strText, " ")
        strUnit = Right$(strText, Len(strText) - pos)
        strText = Left$(strText, pos - 1)
        
        If strUnit = "mm" Then
            dblNew = ConvertUnits(CDbl(strText), cdrMillimeter, cdrInch)
            strText = dblNew & " in"
        ElseIf strUnit = "in" Then
            dblNew = ConvertUnits(CDbl(strText), cdrInch, cdrMillimeter)
            strText = dblNew & " mm"
        End If

        s.GetPosition x, y
        dblRotate = s.RotationAngle
        If dblRotate <> 0 Then
            x = x + s.SizeWidth + 0.056
        Else
            y = y - s.SizeHeight - 0.056
        End If

        Set sText = ActiveLayer.CreateArtisticText(x, y, strText, cdrEnglishUS, , s.Text.Story.Font, s.Text.Story.Size, , , , cdrCenterAlignment)
        sText.SetPosition x, y
        If dblRotate <> 0 Then sText.RotationAngle = dblRotate
    Next s
End Sub
-Shelby
Reply With Quote
  #4  
Old 11-07-2008, 10:36
vindaa
Guest
 
Posts: n/a
Default

You are right the userform does gives an error. I will wait till you get some time.

Thanks
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
Document Units Gadget CorelDRAW/Corel DESIGNER VBA 2 14-02-2008 06:34
Parameter units keytecstaff CorelDRAW/Corel DESIGNER VBA 2 10-10-2006 22:07
Display Current Scale Drumart Macros/Add-ons 1 06-07-2006 07:06
How to display corel color window? CorelUser CorelDRAW/Corel DESIGNER VBA 2 02-08-2003 12:41
How do you display and retrieve from... Steve CorelDRAW/Corel DESIGNER VBA 2 06-05-2003 14:33


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


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