OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Corel User Forums > CorelDRAW > Macros/Add-ons

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 21-06-2011, 01:59
beczukdavid
Guest
 
Posts: n/a
Default Please help with debug!

Please I need some help. I have a bug in my macro and I can not figure out what is wrong at this moment and I need my macro badly.

Code:
Global Cerniera
Sub cer_lunga()
    Dim df_copy As Shape
    Dim holder As Shape
    Dim doc As Document
    Dim lyr As Layer
    Dim foc As ActiveView
    Dim dx#, dy#, dp#
    Dim grf As Shape
    
    Dim a#, b#, c#, d#
                 
    Set doc = ActiveDocument
        
    doc.Unit = cdrMillimeter
    Set lyr = FindLayer(ActivePage, "temp")
    Set df_copy = ActiveSelection.Duplicate
    df_copy.MoveToLayer lyr
    df_copy.ObjectData("Name").Value = "test"
    
    dx = df_copy.TopY
    dy = df_copy.CenterX
    dp = dy - dx * 2
    
    df_copy.Move 0, dp
    ' Set foc = Focus(doc)
            
    ' Create PowerClip Boxes
    dx = ActiveLayer.Shapes("test").SizeHeight
    dy = ActiveLayer.Shapes("test").SizeWidth
        
    a = ActiveSelection.LeftX - 2.5
    b = ActiveSelection.BottomY - 2.5
    ActiveLayer.CreateRectangle2 a, b, (ActiveSelection.SizeWidth + 5), (ActiveSelection.SizeHeight + 5), 0, 0, 0, 0
    ActiveSelection.Outline.SetNoOutline
    ActiveSelection.ObjectData("name").Value = "holder_left"
    ActiveSelection.SetSizeEx a, b, (ActiveSelection.SizeWidth / 2), (ActiveSelection.SizeHeight)
    Set df_copy = ActiveSelection.Duplicate
    df_copy.ObjectData("Name").Value = "holder_right"
    c = df_copy.RightX - df_copy.LeftX
    df_copy.Move c, 0
    ActiveLayer.Shapes("holder_left").AddToSelection
    ActiveSelection.Group
    df_copy.ObjectData("Name").Value = "holder"
    
    ActiveLayer.Shapes("test").CreateSelection
    ' ActiveLayer.Shapes("holder").CreateSelection
    Set grf = ActiveSelection
    holder.AddToPowerClip grf
    
    ActiveLayer.Shapes("holder").CreateSelection
    ActiveSelection.Ungroup
    ActiveLayer.Shapes("holder_left").Move -(Cerniera / 2), 0
    ActiveLayer.Shapes("holder_right").Move (Cerniera / 2), 0
    ActiveSelection.Group
    ' Set foc = Focus(doc)
    
    Unload cer_lng
    
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

Function Focus(ByVal doc As Document) As ActiveView
    
    ' Focus Object
    Windows.FindWindow(doc).ActiveView.ToFitSelection
    Windows.FindWindow(doc).ActiveView.ZoomOut

End Function
Reply With Quote
  #2  
Old 21-06-2011, 09:27
shark shark is offline
Senior Member
 
Join Date: Aug 2010
Location: Russia, Belgorod
Posts: 146
Default

Too many lines of code. What purpose of this macro ? What it must do?
Reply With Quote
  #3  
Old 23-06-2011, 03:08
beczukdavid
Guest
 
Posts: n/a
Default

The macro I made to help me speed up my work process.

And in short explanation, takes a graphic puts it in 2 grouped rectangles, the rectangles are grouped and turned into a powerclip.

The macro makes the ZIP cut for cycling t-shirts. But you can test the macro with any object. It should cut the object in half (virtualy), really what happens is that the graphics is hidden by the powerclip for later edit process.

I hope I explained correctly.

If you need the gms file just let me know.

Thanks
Reply With Quote
  #4  
Old 23-06-2011, 04:28
shark shark is offline
Senior Member
 
Join Date: Aug 2010
Location: Russia, Belgorod
Posts: 146
Default

I do not tested your code, better write my own
Try add such line after ActiveSelection.Outline.SetNoOutline
ActiveSelection.Fill.ApplyNoFill
and
holder.AddToPowerClip grf
change to
holder.AddToPowerClip grf, false
May be it will help
Reply With Quote
  #5  
Old 24-06-2011, 02:16
beczukdavid
Guest
 
Posts: n/a
Default

Thank you for your reply.
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


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


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