Create a shape based on external X,Y coordinates

[Miki]

Hello,
I have a csv file that lists X and Y coordinates for various polygons. I have a master shape called "Polygon" with some features like area and name in the text field.
Sample of csv file:

ShapeID    ShapeNumber   X    Y     0                    1               0    0     1                    1               1    0     2                    1               1    1     3                    1               0    1     4                    1               0    0     5                    2               5    5     6                    2               6    5     7                    2               6    6     8                    2               5    6     9                    2               5    5

These are 2 squares shapes, one with its bottom left corner at 0,0 and other one at 5,5.

The question is, how do I plot this, using my "Polygon" master, such that it takes up the coordinates listed in the table.  So one "Polygon" will be at 0,0 and other at 5,5.

Any help is appreciated.

Thanks,
- Miki

[Surrogate]

1. ShapeID <> 0 !!!
2. What are you mean as  ShapeNumber ?

[Miki]

1. ShapeID is not visio's Shape ID. It's an output from a GIS shapefile, hence, its a unique sequence for all the points on a particular layer.
2. Shapenumber: If you have 5 shapes on a particular layer, then each shape will have a ShapeNumber.

So, in the example I gave, ShapeNumber 1 has 4 vertices (0,0; 1,0; 1,1; 0,1) and the 5th vertex (0,0 again) closes the shape. The ShapeID helps in determining the sequence of these vertices i.e. 1,1 comes after 1,0 and not vice-versa.

So, if I want to plot ShapeNumber 1, it will be a square with sides of 1 unit.

The question is, how do I do this? How to I use this table to plot the shapes using a master?

Thanks,
- Miki

[wapperdude]

Here's partial answer.  This code draws four lines, creates a closed shape, and then adds fill color.  Still need to fetch the data from CSV or more likely, from Excel.

Code Select Expand

Public Sub Lines2rectangle()

    Dim vsoSide1 As Visio.Shape
    Dim vsoSide2 As Visio.Shape
    Dim vsoSide3 As Visio.Shape
    Dim vsoSide4 As Visio.Shape
    Dim vsoRect1 As Shape
   
    'Need to import the line endpoints from Excel
    'Constructing rectangle could use DrawRectangle, which only requires the diagonal pair of points.
   
    'Draw the four lines:
        Set vsoSide1 = ActivePage.DrawLine(0, 0, 1, 0)
        Set vsoSide2 = ActivePage.DrawLine(1, 0, 1, 1)
        Set vsoSide3 = ActivePage.DrawLine(1, 1, 0, 1)
        Set vsoSide4 = ActivePage.DrawLine(0, 0, 0, 0)
         
    'Create rectangle shape:
        ActiveWindow.DeselectAll
        ActiveWindow.Select vsoSide1, visSelect
        ActiveWindow.Select vsoSide2, visSelect
        ActiveWindow.Select vsoSide3, visSelect
        ActiveWindow.Select vsoSide4, visSelect
        ActiveWindow.Selection.Join         'Closed shape created; still selected at this point
       
     'Open shapesheet and populate:
        ActiveWindow.Selection.PrimaryItem.OpenSheetWindow
        ActiveWindow.Shape.CellsSRC(visSectionFirstComponent, 0, 0).FormulaU = 0
        ActiveWindow.Shape.CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(255,192,0))"
        ActiveWindow.Shape.CellsSRC(visSectionObject, visRowFill, visFillBkgnd).FormulaU = "THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEME(""FillColor""),THEME(""FillColor2""))))"
        ActiveWindow.Shape.CellsSRC(visSectionObject, visRowFill, visFillPattern).FormulaU = "1"
        ActiveWindow.Close
   
    ActiveWindow.DeselectAll

End Sub

Anyway, it's a start.

Wapperdude

[JohnGoldsmith]

Hello Miki,

It occurs to me that the POLYLINE function might be helpful to you here.  This takes array of x/y coordinates and would fairly easily convert from your existing data.  Using this function coordinates are defined either locally (to the space of the hosting shape) or relative as a percentage of the shape. 

If your master shape contained a default PolylineTo geometry row, then you could simply address the A cell and push the corresponding POLYLINE function (with your data) into it.

There's a few examples of polyline use that might help your understanding of how it's used in Visio:

   
• Simple Visio Sparkline implementation
• Creating PolyLines From Existing Shapes in Visio
• Polyline Shape Maker

Hope that helps.

Best regards

John

[Miki]

Looks like I have some work to do 
I'll try both the methods and will report back which one worked the best.
Thanks Wapperdude and John!

[wapperdude]

Here's follow-up to my post.  Code now includes call to an Excel file which has the line points in it.  The code calls a specific file, so it will have to be edited.  I've included a Visio file which has the code embedded and a Line Data file, mostly based upon your CSV file.  It should be noted, that only 4 data points (2 for x, and 2 for y) are really needed to draw the lines for the square, or even simpler use the DrawRectangle method.

Also, the code needs to be modified to include some loops to facilitate looping thru all of the squares that need to be drawn.  But, I think this provides sufficient info to move forward.


Here's the code, for those who don't want to bother with the files:

Code Select Expand

Dim xp1 As Double
Dim xp2 As Double
Dim xp3 As Double
Dim xp4 As Double
Dim yp1 As Double
Dim yp2 As Double
Dim yp3 As Double
Dim yp4 As Double
Public Sub Lines2rectangle()

    Dim vsoSide1 As Visio.Shape
    Dim vsoSide2 As Visio.Shape
    Dim vsoSide3 As Visio.Shape
    Dim vsoSide4 As Visio.Shape
    Dim vsoRect1 As Shape
   
    'Need to import the line endpoints from Excel
    'Could be done using drawrectangle, then you just need the diagonal pair of points.
   
    Call ExcelImport
   
    'Draw the four lines:
        Set vsoSide1 = ActivePage.DrawLine(xp1, yp1, xp2, yp2)
        Set vsoSide2 = ActivePage.DrawLine(xp2, yp2, xp3, yp3)
        Set vsoSide3 = ActivePage.DrawLine(xp3, yp3, xp4, yp4)
        Set vsoSide4 = ActivePage.DrawLine(xp4, yp4, xp1, yp1)
         
    'Create rectangle shape:
        ActiveWindow.DeselectAll
        ActiveWindow.Select vsoSide1, visSelect
        ActiveWindow.Select vsoSide2, visSelect
        ActiveWindow.Select vsoSide3, visSelect
        ActiveWindow.Select vsoSide4, visSelect
        ActiveWindow.Selection.Join         'Closed shape created
       
     'Open shapesheet and populate:
        ActiveWindow.Selection.PrimaryItem.OpenSheetWindow
        ActiveWindow.Shape.CellsSRC(visSectionFirstComponent, 0, 0).FormulaU = 0
        ActiveWindow.Shape.CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(255,192,0))"
        ActiveWindow.Shape.CellsSRC(visSectionObject, visRowFill, visFillBkgnd).FormulaU = "THEMEGUARD(SHADE(FillForegnd,LUMDIFF(THEME(""FillColor""),THEME(""FillColor2""))))"
        ActiveWindow.Shape.CellsSRC(visSectionObject, visRowFill, visFillPattern).FormulaU = "1"
        ActiveWindow.Close                  'Close the shapesheet
   
        ActiveWindow.DeselectAll            'Deselect shape, ready to make more.

End Sub

Private Sub ExcelImport()
' ******************************************************************************************
    Dim xlApp As Object                                 'Use this for late binding.  Method2 can use either and establishes either early or late binding.
    Dim myExBook As excel.Workbook                      'use a variable for each function.  Allows each to be released at end of program.  This releases all aspects of Excel.  Supposed to be a good thing.
    Dim myExSheet As excel.Worksheet                    'variable for Excel Sheet
    Dim myCellVal As String
   
    Set xlApp = CreateObject("Excel.Application")           'use this with early or late binding
    Set myExBook = xlApp.Workbooks.Open("D:\MyTemporary\MyLineData.xlsx")
    Set myExSheet = myExBook.Worksheets("Sheet1")           'Need to explicitly use this call to allow repeated code executions without error.  Without it, VBA assigns its own references.  Bad 2nd time thru
    xlApp.Visible = False
    xlApp.ScreenUpdating = False                            'Prevents screen from updating during execution.  Set to "True" later to get a screen refresh
     
    'Get Excel data.  This could be parameterized, put into a loop.
        xp1 = myExSheet.Cells(2, 3)
        yp1 = myExSheet.Cells(2, 4)
        xp2 = myExSheet.Cells(3, 3)
        yp2 = myExSheet.Cells(3, 4)
        xp3 = myExSheet.Cells(4, 3)
        yp3 = myExSheet.Cells(4, 4)
        xp4 = myExSheet.Cells(5, 3)
        yp4 = myExSheet.Cells(5, 4)
        xp5 = myExSheet.Cells(6, 3)
        yp5 = myExSheet.Cells(6, 4)

' TIDY UP AND END
    xlApp.ScreenUpdating = True

    Set myExSheet = Nothing                                         'Release worksheet
    Set myExBook = Nothing                                          'Release workbook
    Set xlApp = Nothing                                             'Release Excel application
End Sub


Wapperdude

[Miki]

Wapperdude,
This is a great help to move forward. It works as needed. Just a few changes are needed as you mentioned.
Thank you so much!!!

- Miki