macro request - Cloud Drawer

Is there such a possibility of creating a cloud-drawing macro for Draw?  Something that will draws circles at points you click, then it welds them all and deletes the center junk?

By cloud note, I'm referring to the cloud drawer in Acrobat Pro or AutoCAD.

  • Hello signcoartdtp; It hardly takes anytime to make a Cloud, and how often do you need them?

    George

  • signcoartdtp said:

    Is there such a possibility of creating a cloud-drawing macro for Draw?  Something that will draws circles at points you click, then it welds them all and deletes the center junk?

    By cloud note, I'm referring to the cloud drawer in Acrobat Pro or AutoCAD.

    You can try code below (created na testd on X5) - it’s placing symbol from the symbol library (located on C:\clouds.csl)
    zipped sample library attached (uzip an save to c:\)
    1. click  = symbol called cloud1
    2. shift+click  = symbol called cloud2
    3. ctrl+click  = symbol called cloud3
    4. alt+clik  = symbol called cloud4

    when symbol inserted then it’s reverted to an object
    you can insert symbols repeatedly - until pressing Esc or waiting two seconds from last click (this delay finish macro code)


    Sub Symbol_on_Click()
    Dim SymLibClouds As SymbolLibrary, cloud As Shape, clname As String
    Dim x As Double, y As Double, shift As Long
    Dim b As Boolean
      Set SymLibClouds = SymbolLibraries.Add("C:\clouds.csl", False) 'location of your clouds,i.e.=library with symbols
      b = False
      While Not b
       b = ActiveDocument.GetUserClick(x, y, shift, 2, False, cdrCursorWinCross)
        If Not b Then
        If shift = 0 Then clname = "cloud1"
        If (shift And 1) <> 0 Then clname = "cloud2"
        If (shift And 2) <> 0 Then clname = "cloud3"
        If (shift And 4) <> 0 Then clname = "cloud4"
        Set cloud = ActiveLayer.CreateSymbol(x, y, clname, SymLibClouds)
        cloud.Symbol.RevertToShapes
        End If
      Wend
     SymbolLibraries("C:\clouds.csl").Delete
    End Sub


    Best regards

    Mek 

     

    • Thanks Mek.  That's a start.  I just need a way to draw the bounding area that will contain the cloud.  Richard, I'm already aware of how to manually make a cloud.  I prefer to do it a little faster and whatnot.

      • ggut said:

         I just need a way to draw the bounding area that will contain the cloud. 

        Sub Clouds()
         Dim SymLibClouds As SymbolLibrary, cloud As Shape, clname As String
         Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double
         Dim Shift As Long
         Dim b As Boolean
         Set SymLibClouds = SymbolLibraries.Add("c:\clouds.csl", False) 'location of your clouds,i.e.=library with symbols
         b = ActiveDocument.GetUserArea(x1, y1, x2, y2, Shift, 5, False, cdrCursorWinCross)
         If Not b Then
           If Shift = 0 Then clname = "cloud1"
            If (Shift And 1) <> 0 Then clname = "cloud2"
            If (Shift And 2) <> 0 Then clname = "cloud3"
            If (Shift And 4) <> 0 Then clname = "cloud4"
            Set cloud = ActiveLayer.CreateSymbol(x1, y1, clname, SymLibClouds)
            cloud.SetSize x2 - x1, y2 - y1
            cloud.SetPosition x1, y1
            cloud.Symbol.RevertToShapes
            End If
          SymbolLibraries("c:\clouds.csl").Delete
        End Sub 

        Best regards

        Mek

        • Hello,

          I am looking to draw clouds within a bounding area just like the original comment above.  I'm a novice, although I have been using CorelDraw for a number of years.  I only use it maybe twenty times each year.  That said, respectively, how do I make use of the macro above?  I would like to give it a try.

          • alt+shift+F11 (Tools/Macros/Macro Manager)

            Right click on Visual Basic for Applications and choose New Macro Project

            Name it "Clouds" without the quotes, hit save

            you'll see it pop up at the bottom of Macro Manager

            click off that then right click on it and choose New Module

            click off that then right click on it and choose New Macro

            copy and paste the code above then in the editor highlight

            Sub Macro1() & End Sub then paste