Consulting

Results 1 to 6 of 6

Thread: Building complex shapes using the freeFormBuilder

  1. #1

    Building complex shapes using the freeFormBuilder

    Hello,

    First post here, so apologies if it is too detailed!

    I have created a set of icons using PowerPoint shapes and rather than have them as a collection in a reference file I am looking to see if I can reconstruct them programmatically so that I could create a customised Ribbon Gallery. As an example, consider the following shape which is constructed simply by using the "Union" function of a three quarter pie shape and a quarter pie shape. It is made up of 8 nodes.

    Picture1.jpgPicture2.jpg

    To try and do this, I have looked at exporting the existing nodes and their properties with the following code:

    Sub GetPoints()
    
    Dim sh As Shape
    Dim nd As ShapeNode
    Dim xy As Variant
    Dim nodemsg As String
    Dim Seg As String
    Dim Edit As String
    
    Set sh = ActiveWindow.Selection.ShapeRange(1)
    
    For Each nd In sh.Nodes
        xy = nd.Points
        
        Select Case nd.SegmentType
            Case 1: Seg = "msoSegmentCurve"
            Case 0: Seg = "msoSegmentLine"
    
        End Select
        Select Case nd.EditingType
            Case 0: Edit = "msoEditingAuto"
            Case 1: Edit = "msoEditingCorner"
            Case 2: Edit = "msoEditingSmooth"
            Case 3: Edit = "msoEditingSymmetric"
        End Select
        
        nodemsg = nodemsg & ".AddNodes " & Seg & ", " & Edit & ", " & xy(1, 1) & ", " & xy(1, 2) & vbCrLf
    Next
    
    Debug.Print nodemsg
    
    End Sub
    From this I can tell that there are in fact 17 nodes, which after some digging is because it includes the "handles" of each point as additional nodes as well. If I try to then reconstruct a shape using freeform builder and the output of the first code I get this:

    Picture3.jpg

    Sub construct()
    
    Dim freeFormBuilder As freeFormBuilder
    Dim mySlide As Slide
    Dim myShape As Shape
    
    Set mySlide = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideIndex)
    Set freeFormBuilder = mySlide.Shapes.BuildFreeform(msoEditingCorner, 139.9373, 280.6482)           'uses the output for the 1st node
    
    With freeFormBuilder
        .AddNodes msoSegmentLine, msoEditingCorner, 245.2909, 280.6482           'uses the output for the 2nd node onwards
        .AddNodes msoSegmentCurve, msoEditingCorner, 245.2909, 338.8334
        .AddNodes msoSegmentCurve, msoEditingCorner, 198.1225, 386.0018
        .AddNodes msoSegmentCurve, msoEditingCorner, 139.9373, 386.0018
        .AddNodes msoSegmentCurve, msoEditingAuto, 125.4049, 160.7621
        .AddNodes msoSegmentCurve, msoEditingCorner, 183.5902, 160.7621
        .AddNodes msoSegmentCurve, msoEditingCorner, 230.7586, 207.9306
        .AddNodes msoSegmentCurve, msoEditingCorner, 230.7586, 266.1158
        .AddNodes msoSegmentLine, msoEditingAuto, 125.4049, 266.1158
        .AddNodes msoSegmentLine, msoEditingCorner, 125.4049, 371.4695
        .AddNodes msoSegmentCurve, msoEditingAuto, 67.21969, 371.4695
        .AddNodes msoSegmentCurve, msoEditingAuto, 20.05126, 324.301
        .AddNodes msoSegmentCurve, msoEditingAuto, 20.05126, 266.1158
        .AddNodes msoSegmentCurve, msoEditingAuto, 20.05126, 207.9306
        .AddNodes msoSegmentCurve, msoEditingAuto, 67.21969, 160.7621
        .AddNodes msoSegmentCurve, msoEditingAuto, 125.4049, 160.7621
        .AddNodes msoSegmentLine, msoEditingAuto, 139.9373, 280.6482           'Repeats the output for the first node to close off the freeform
    End With
    
    Set myShape = freeFormBuilder.ConvertToShape
    
    End Sub
    With a bit of trial and error I was able to use the co-ordinates to create a replica shape, however there are two issues with this approach in that
    a) it's not automatic and I have a lot of icons, some of which are much more complicated
    b) When applying an outline to the original icon, it applies two outlines, one to each part of the shape. With my newly built one it also has a line connecting the two segments which I don't want

    Picture4.jpg

    Sub construct2()
    
    Dim freeFormBuilder As freeFormBuilder
    Dim mySlide As Slide
    Dim myShape As Shape
    
    Set mySlide = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideIndex)
    Set freeFormBuilder = mySlide.Shapes.BuildFreeform(msoEditingCorner, 139.9373, 280.6482)
    
    With freeFormBuilder
        .AddNodes msoSegmentLine, msoEditingCorner, 245.2909, 280.6482
        .AddNodes msoSegmentCurve, msoEditingCorner, 245.2909, 338.8334, 198.1225, 386.0018, 139.9373, 386.0018
        .AddNodes msoSegmentCurve, msoEditingCorner, 139.9373, 280.6482
        .AddNodes msoSegmentLine, msoEditingCorner, 125.4049, 160.7621
        .AddNodes msoSegmentCurve, msoEditingCorner, 183.5902, 160.7621, 230.7586, 207.9306, 230.7586, 266.1158
        .AddNodes msoSegmentCurve, msoEditingCorner, 125.4049, 266.1158
        .AddNodes msoSegmentCurve, msoEditingCorner, 125.4049, 371.4695
        .AddNodes msoSegmentCurve, msoEditingCorner, 67.21969, 371.4695, 20.05126, 324.301, 20.05126, 266.1158
        .AddNodes msoSegmentCurve, msoEditingCorner, 20.05126, 207.9306, 67.21969, 160.7621, 125.4049, 160.7621
        .AddNodes msoSegmentLine, msoEditingCorner, 139.9373, 280.6482
    End With
    
    Set myShape = freeFormBuilder.ConvertToShape
    
    End Sub
    Would anyone be able to help me figure this out as I've been stuck on it for ages? The best solution would be one that takes a selected shape, reads its node properties, then creates an identical new shape next to it.

    Thanks in advance for any help

  2. #2
    I realise you're not supposed to bump threads, but given it's been a couple of months I figure it's worth a try before I give up on this problem...

    Thanks in advance if anyone does have any ideas
    Last edited by rdekanter; 06-19-2018 at 07:06 AM.

  3. #3
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Well ...

    you could

    1. manually create the shapes you want (formatting, grouping, etc.)

    2. put them on a hidden slide or slides

    3. give each a meaningful name

    4. then have the macro copy the shape and insert it
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  4. #4
    Thanks for the suggestion Paul,

    unfortunately I can't do this as I am trying to make it part of an Add In file so that once installed a user will always have access to the functions whenever PowerPoint is open and without having to go searching for files. As far as I can tell, you cannot reference a slide in an Add In because PowerPoint strips all slides when it creates the add in.

    EDIT:
    I tried locating a separate file, opening it, copying a relevant shape, closing the file and then pasting it. Seems to be acceptably quick so I should be able to make this work as a companion file
    Last edited by rdekanter; 06-20-2018 at 01:25 AM.

  5. #5
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    As Paul suggests we always use a reference file open it with no window copy the correct shape and close it again. If you install the Add from an msi you can also create the reference file in a hidden location.
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  6. #6
    Code snippet in case any one is interested

    'Create new PowerPoint object and open Icon Set fileSet pPowerPoint = New PowerPoint.Application
    Set SourcePPT = pPowerPoint.Presentations.Open(SourcePPTPath)
    
    
    'Copy icon and close source file
    SourcePPT.Slides(1).Shapes(selectedID).Copy
    SourcePPT.Close
    Set SourcePPT = Nothing
    
    
    'Paste shape on current slide
    With ActiveWindow
        .View.Paste
        .Selection.ShapeRange.Left = 100
        .Selection.ShapeRange.Top = 100
    End With

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •