OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Reply
 
Thread Tools Search this Thread Display Modes
  #21  
Old 18-03-2018, 05:02
dungbtl's Avatar
dungbtl dungbtl is offline
Senior Member
 
Join Date: Apr 2004
Posts: 137
Default

Jinkies! 10 years ago

Is it possible to get this updated for Coreldraw 2017 ??
Nothing happens & I've never had much of a clue

Thanks!
Reply With Quote
  #22  
Old 20-03-2018, 15:59
knowbodynow knowbodynow is offline
Senior Member
 
Join Date: Mar 2006
Location: Hatsukaichi near Hiroshima
Posts: 429
Default

Not sure if this is relevant or will work with Coreldraw 2017 but this is the basic code I use for replacing objects with copies of another. The first object selected is the one that will replace all the others:

Code:
Sub ReplaceObjects()

Dim ocount As Integer, n As Integer
Set sr = New ShapeRange

If Not ActiveSelection.Shapes.Count > 1 Then Exit Sub

ocount = ActiveSelection.Shapes.Count
n = ocount - 1

Optimization = True
ActiveDocument.BeginCommandGroup "Replace With Duplicate"
 
While ocount > 1

If ActiveSelection.Shapes(ocount).Type = cdrTextShape Then

    If ActiveSelection.Shapes(ocount).text.Type = cdrArtisticText Then
    
        ActiveSelection.Shapes(ocount).text.Story.InsertAfter "txg"
        
        If ActiveSelection.Shapes(1).Type = cdrArtisticText Then
          If ActiveSelection.Shapes(1).text.Type = cdrArtisticText Then
            ActiveSelection.Shapes(1).text.Story.InsertAfter "txg" 'to make text align vertically
          End If
        End If
        
        Set s = ActiveSelection.Shapes(ocount).Duplicate
        s.AlignToShape cdrAlignVCenter, ActiveSelection.Shapes(1)
        
         Set tr = ActiveSelection.Shapes(ocount).text.Story.Duplicate()
        tr.Start = tr.End - 3
        tr.Delete
        
        Set tr = s.text.Story.Duplicate()
        tr.Start = tr.End - 3
        tr.Delete
        
        s.AlignToShape cdrAlignHCenter, ActiveSelection.Shapes(1)
        
        ActiveSelection.Shapes(1).Delete
    Else
  
        Set s = ActiveSelection.Shapes(ocount).Duplicate
        s.AlignToShape 15, ActiveSelection.Shapes(1)
        ActiveSelection.Shapes(1).Delete

    End If

Else

    Set s = ActiveSelection.Shapes(ocount).Duplicate
       
    s.AlignToShape 15, ActiveSelection.Shapes(1)
    ActiveSelection.Shapes(1).Delete

End If

sr.add s

ocount = ocount - 1
Wend

     ActiveDocument.EndCommandGroup
     Optimization = False
     Application.Refresh
     
 If n = 1 Then sr.CreateSelection

End Sub
Let me know if it does anything and if it does whether that is what you want. Cheers.
Reply With Quote
  #23  
Old 21-03-2018, 15:56
dungbtl's Avatar
dungbtl dungbtl is offline
Senior Member
 
Join Date: Apr 2004
Posts: 137
Default

Knowbody

Nice code but it's far different from what wOxxOm made prior.

I liked the fact that the cursor changed and you can select any
object to change into. I use this in x4 alot and its quite helpful
and pretty quick. See if you can get it to work and give it a try.

wOxxOm's code DOES WORK in 2017
Just doesnt change the cursor/picktool

Code im using now:

Code:
Sub ReplaceObjects() 'Original Object Replacer
   Dim sh As Shape, sr As ShapeRange, x#, y#, w#, h#, i&
   Dim AgentSmith As Shape, VSR As ShapeRange
   
   If ActiveDocument Is Nothing Then Exit Sub
   Set sr = ActiveSelection.Shapes.FindShapes()
   If sr.Count = 0 Then
      MsgBox "Select target objects, invoke the macro, click Agent Smith shape"
      Exit Sub
   End If
   If ActiveDocument.GetUserClick(x, y, i, -1, Snap:=False, CursorShape:=313) Then _
      Exit Sub
   
   With ActivePage.SelectShapesAtPoint(x, y, SelectUnfilled:=True)
      If .Shapes.Count = 0 Then Beep: Exit Sub
      Set AgentSmith = .Shapes(.Shapes.Count)
   End With

   Set VSR = New ShapeRange
   ActiveDocument.ReferencePoint = cdrCenter
   For Each sh In sr
      sh.GetBoundingBox x, y, w, h
      With AgentSmith.TreeNode.GetCopy
            .VirtualShape.RotationAngle = sh.RotationAngle
         .VirtualShape.SetBoundingBox x, y, w, h, KeepAspect:=True
         .LinkAsChildOf sh.Layer.TreeNode
         VSR.Add .VirtualShape
      End With
   Next
   
   ActiveDocument.LogCreateShapeRange VSR
   sr.Delete ' evaporate originally selected shapes
End Sub
I guess I need to know the CursorShape:= ?#?, 313 doesnt apply.

Anyone know how to change the cursor shape?

Wonder what happened of @wOxxOm ?

Last edited by dungbtl; 21-03-2018 at 16:23.
Reply With Quote
  #24  
Old 25-03-2018, 08:28
knowbodynow knowbodynow is offline
Senior Member
 
Join Date: Mar 2006
Location: Hatsukaichi near Hiroshima
Posts: 429
Default

It works but I don't find it useful at all. Sorry, don't know how to get the cursor working.
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
Trouble wtih shape names. jahmer Macros/Add-ons 13 23-01-2008 19:05
Symbol shape is not found in a group squonk CorelDRAW/Corel DESIGNER VBA 1 14-06-2007 06:32
CorelDRAW X3 VBA Code - Shape & Color LIster JudyHNM Code Critique 2 05-04-2007 14:02
Any idea what's wrong with this shape? jemmyell CorelDRAW/Corel DESIGNER VBA 4 08-05-2006 18:15
Howto uniquely identify a shape in VBA code jemmyell CorelDRAW/Corel DESIGNER VBA 9 11-02-2005 21:05


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


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