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 22-12-2005, 02:54
Zizy
Guest
 
Posts: n/a
Thumbs down Some new questions

It's me again
1) I can not find angle, painted on a picture. Text is textonpath, path is circle.
2) I can not view some shape in the left side of my work space. Maybe I shall situate my form in right side (picture)
3) And last. Can I save some worksheets of my CDRfile in other CDRfile without macroses. It is not Save as...

Thank you for answering
Attached Images
  
Reply With Quote
  #2  
Old 22-12-2005, 13:58
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
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 Finding Dimensions

To find Dimensions like the picture you posted use the Dimension tool, it has an angle option and will find the angle for you.

Good luck,

Shelby
Reply With Quote
  #3  
Old 22-12-2005, 14:02
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
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 Save without Macros

I am not sure how to save without Macros, but I would suggest not putting your code in the CDR unless you have to. I much prefer just making my own GMS.

Shelby
Reply With Quote
  #4  
Old 28-12-2005, 02:51
Zizy
Guest
 
Posts: n/a
Default

1) Dimension tool is not for me. I need to calculate this angle in my macros

2) Saving without macros:

Dim opt As New StructSaveAsOptions
opt.EmbedICCProfile = False
opt.EmbedVBAProject = False --- with/without
opt.Filter = cdrCDR
opt.IncludeCMXData = False
opt.Overwrite = True
opt.Range = cdrAllPages
opt.ThumbnailSize = cdr10KColorThumbnail
opt.Version = cdrVersion9

ActiveDocument.SaveAs "c:\crldrw.cdr", opt

3) Can I get koordinates of my work space?
4) How I can add to selection some area? (x1,y1) to (x2,y2)?

Last edited by Zizy; 28-12-2005 at 02:54.
Reply With Quote
  #5  
Old 29-12-2005, 02:30
Zizy
Guest
 
Posts: n/a
Default

4) ActiveDocument.ActivePage.SelectShapesFromRectangle
And what about others?
Reply With Quote
  #6  
Old 29-12-2005, 23:33
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default

Zizy,

About finding the angle, it is not a trivial thing to do. The problem is that there is no easy way of determining the coordinates of a particular letter, so you can't get the point of the end of a text object.

However I came up with the workaround: I duplicate the original object, add a "." to the end, convert the text to curves and since my dot will be the last character of the text, it will be the last subpath of the resulting curve, so I just get the coordinates of the first node of that subpath and it will be a reasonable estimate of the end of the original text object.

Then it is just a pure math of finding angle between two vectors.

Here is a working example - select two text objects fitted to a path and run the following macro:

Code:
Sub FindAngle()
    Dim x1 As Double, y1 As Double
    Dim x2 As Double, y2 As Double
    Dim x0 As Double, y0 As Double
    Dim dLen As Double, dDot As Double
    Dim dAngle As Double
    Dim sr As ShapeRange
    Dim sPath As Shape
    Dim strText As String
    
    Set sr = ActiveSelection.Shapes.FindShapes(Type:=cdrTextShape)
    If sr.Count <> 2 Then
        MsgBox "The selection must contain two text objects fitted to path", vbCritical
        Exit Sub
    End If
    
    ' Find the end of the first text object
    GetEndOfText sr(1), x1, y1
    ' Find the end of the second text object
    GetEndOfText sr(2), x2, y2
    
    ' Find the center of the path.
    ' Assume that both text objects are fitted to
    ' either the same path or paths with the same center
    
    If sr(1).Effects.TextOnPathEffect Is Nothing Then
        MsgBox "Text objects must be fitted to path", vbCritical
        Exit Sub
    End If
    
    Set sPath = sr(1).Effects.TextOnPathEffect.TextOnPath.Path
    ActiveDocument.ReferencePoint = cdrCenter
    sPath.GetPosition x0, y0
    
    ' Draw the leader lines to indicate the angle we found
    ActiveLayer.CreateLineSegment x0, y0, x1, y1
    ActiveLayer.CreateLineSegment x0, y0, x2, y2
    
    ' Find the angle between the end points of the text objects and the center of the path
    x1 = x1 - x0
    y1 = y1 - y0
    x2 = x2 - x0
    y2 = y2 - y0
    
    dDot = x1 * x2 + y1 * y2 ' Dot product of the vectors
    dLen = Sqr((x1 * x1 + y1 * y1) * (x2 * x2 + y2 * y2))
    dAngle = arccos(dDot / dLen)
    
    strText = "Angle = " & Format(dAngle, "0.00") & " degrees"
    ActiveLayer.CreateArtisticText x0 + (x1 + x2) / 2, y0 + (y1 + y2) / 2, strText
End Sub

Private Sub GetEndOfText(ByVal sText As Shape, ByRef x As Double, y As Double)
    Dim sDup As Shape
    ' Make a temporary duplicate of the text
    Set sDup = sText.Duplicate
    ' Add a DOT at the end of the text
    sDup.Text.Story.InsertAfter "."
    ' Convert the text to curves
    sDup.ConvertToCurves
    ' Get the position of the first node of the last subpath of the curve
    sDup.Curve.SubPaths(sDup.Curve.SubPaths.Count).StartNode.GetPosition x, y
    ' Delete the duplicate
    sDup.Delete
End Sub

Private Function arccos(ByVal x As Double) As Double
    Const pi As Double = 3.14159265358979
    If x >= 1 Then
        arccos = 0
    ElseIf x <= -1 Then
        arccos = 180
    Else
        arccos = 90 - Atn(x / Sqr(1 - x * x)) * 180 / pi
    End If
End Function
To save a CDR file without embedded VBA macros, just go to the File Save dialog, click the "Options >>" button at the bottom to expand the dialog and uncheck the "Save with embedded VBA Project" button on the bottom right.

I'm not quite sure what you mean by your question #3 above. What coordinates of workspace you are looking for?
Reply With Quote
  #7  
Old 23-01-2006, 02:52
Zizy
Guest
 
Posts: n/a
Default

Sorry that I answer so late.
Thank you. This is very interesting how you do such. And it works!
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
Amateur questions on objects in CorelDRAW Granite Golem General 3 19-08-2004 08:51
*** Read me first before posting new questions *** Alex CorelDRAW/Corel DESIGNER VBA 0 09-03-2004 09:51
Newbie questions Adrian Batchelor CorelDRAW/Corel DESIGNER VBA 2 15-11-2003 12:04
some procedure questions bbolte CorelDRAW/Corel DESIGNER VBA 2 12-12-2002 12:49
VB6, GMS questions bbolte CorelDRAW/Corel DESIGNER VBA 12 06-12-2002 16:32


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


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