Have a master smart shape which will work fine and auto resize itself based on data from an excel sheet.
There is a new diagram I want to create which will involve duplicating the master shape approx 400 times as 400 shapes are required, each of the new shapes will have a unique name.
The duplication could be done by drag and drop but that will take a long time. Is there a command that can be used to duplicate the master shape as the required copies onto the page? There is a text file available of a list of the all the required shapes.
Something like
For every entry in list Do
Dupliate Master as shape1,2,3...
Place duplicate onto page
Then Each shape cad be updated by linking to the shape data by shape name and the diagram will draw itelf.
Any ideas?
Quote from: visio on March 27, 2023, 10:24:38 AMThe duplication could be done by drag and drop but that will take a long time. Is there a command that can be used to duplicate the master shape as the required copies onto the page? There is a text file available of a list of the all the required shapes.
...
Then Each shape cad be updated by linking to the shape data by shape name and the diagram will draw itelf.
You mean replace some shapes in exist page(s) or create new ?
Each time you drop a master on a page, you create a new shape (the master is stored behind the scenes in the document stencil, in principle one master for any amount of shapes you create with the same master).
Is your Master an entire spreadsheet by itself already, or is it one Excel cell and you need to create about 400 of them each connected to data via shape data? If so, that is very doable and provides a lot of possibilities and flexibility.
https://learn.microsoft.com/en-us/office/vba/api/visio.page.dropmany
The duplicated shapes would be of a master in a template. Each of the duplicates would be placed onto an existing page. So this is just to emulate the drag and drop (and rename of the master to the new shape).
Rather than do the same drag and drop a few hundred times would be nice to have this scripted then read from a file.
This was each shape is linked to the Master so if an additional attribute ever required then only need to update the master and all of the duplicate shapes would be updated at the same time
tried using the example in this link https://learn.microsoft.com/en-us/office/vba/api/visio.page.dropmany which duplicates all master templates onto a page with the duplicate shapes having the same name, this is close but not quite there.
Wanting to duplicate a single master as multiple shapes but each with different names and use a driver file or list to speed things up.
Any help appreciated
How do you want the end result to look?
I re-worked the drop many code to work with a single master/shape. The shape, in this code, is selected from the Document stencil. Only the active page is targeted, but a For / Next loop could be used to do all pages and/or add pages. Both the shape and number of placements are hard coded.
HTH
Sub Relicate()
'This macro duplicates a single master / shape on the active page for the desired number of times.number of times.
'Both the shape name and number of shapes are hard coded in this code example.
'At the end, in the immediate window, a summary is debug printed
'Code was re-worked from DropMany code example.
'Wapperdude
Dim mShp As Visio.Master
Dim iCnt As Integer
Dim numShps As Integer
Dim aintIDArray() As Integer
Dim intProcessed As Integer
iCnt = 1
numShps = 5 'Enter number of shapes per page
Set mShp = Documents.Item("Drawing1").Masters.ItemU("Square")
' Debug.Print mShp.Name
ReDim varObjectsToInstance(1 To numShps) As Variant
ReDim adblXYArray(1 To numShps * 2) As Double
For iCnt = 1 To numShps
' Pass name of object to drop to DropMany.
varObjectsToInstance(iCnt) = mShp.Name
' Set x components of where to drop to 2,4,6,2,4,6,2,4,6,...
adblXYArray(iCnt * 2 - 1) = (((iCnt - 1) Mod 3) + 1) * 2
' Set y components to 2,2,2,4,4,4,6,6,6,...
adblXYArray(iCnt * 2) = Int((iCnt + 2) / 3) * 2
Next iCnt
intProcessed = ThisDocument.Pages(1).DropMany(varObjectsToInstance, adblXYArray, aintIDArray)
Debug.Print "Number of shapes Processed: " & intProcessed
Debug.Print "Shp" & Chr(9) & "ID"
For iCnt = LBound(aintIDArray) To UBound(aintIDArray)
Debug.Print iCnt & Chr(9) & aintIDArray(iCnt)
Next iCnt
End Sub
As I think about this, if you need to name each dropped shape, drop many may be wrong method. The core name of each placement is the reference. Each subsequent shape has an incremented ID. The arrays store only Base namre, location, and ID. So It would then be necessary to iterate all of the placed shapes to rename them.
You could write custom code to enable custom naming. Generally, it's not a preferred method to use custom shape names. There are some issues. Rather, the more common practice is to put a reference designation identifier into shapesheet.
The maser shape is a smart shape which represents a standard process and each of the duplicated shapes would represent another process.
The idea is to map an entire process suite which consists of many processes duplicated from the standard process. So each of duplicates would have their own name and be on the same page. then they would position themselves and resize themselves based on the data.
The page links are done via the shape name thus the need to rename the duplicates.
How do you want the end result to look, if you make a mock up then we can understand what you want to achieve!
Quote from: wapperdude on March 27, 2023, 10:34:27 PM
As I think about this, if you need to name each dropped shape, drop many may be wrong method.
My first reaction was to write "why use shape names at all? Use custom properties". But that is not really right. Using shape names help accessing them directly instead of iterating over all shapes. Thus much faster code.
But it is legimate to rename the shapes once, following arbitrary rules - eg: this_and_that_number_ID_Time_or_whatever. The naming could even be performed on the base of prop fields
and especially based on the x,y coordinates, that are known from the DropMany arguments.The arrays would ideally be built from a table (Excel) holding not only the coordinate, but also an ID.
So you'll have once a somewhat longer execution time, but only once - at creation time. Afterwards, you're again at it with accessing the shapes by their name.
"Name", not "NameU".
Attached is what is desired using some test data.
This was actually created in 2014 using Smart Shapes based on the Trilogy post on this site. Looking to redo this using with more shapes and up to date code as it was so successful.
Updated the macro to have better comments, add custom names, and display names.
The code would need to be modified to get data from, e.g., an Excel file, such as shape name, placement location.
Sub DupMany()
'This macro duplicates a single master / shape on the active page for the desired number of times.
'Both the shape name and number of shapes are hard coded in this code example.
'At the end, in the immediate window, a summary is debug printed
'Code was re-worked from the DropMany code example.
'DropMany does not accommodate shape naming. So naming happens after placement.
'Instead of DropMany, use DROP inside a loop. Each shape could be named before dropping.
'Wapperdude
Dim mShp As Visio.Master
Dim iCnt As Integer
Dim numShps As Integer
Dim aintIDArray() As Integer
Dim intProcessed As Integer
Dim vChars As Characters
iCnt = 1
numShps = 15 'Enter number of shapes per page
'This is where MAIN shape to be duplicated is entered
'This example pulls it from Document stencil ...must already be there
Set mShp = Documents.Item("DropMany.vsdm").Masters.ItemU("Square")
Debug.Print mShp.Name
ReDim varObjectsToInstance(1 To numShps) As Variant
ReDim adblXYArray(1 To numShps * 2) As Double
'Populate the arrays with main shape(s), location, and shape IDs
For iCnt = 1 To numShps
' Pass name of object to drop to DropMany.
varObjectsToInstance(iCnt) = mShp.Name
'Change following placement routine as desired. Read in specific values???
' Set x components of where to drop to 2,4,6,2,4,6,2,4,6,...
adblXYArray(iCnt * 2 - 1) = (((iCnt - 1) Mod 3) + 1) * 2
' Set y components to 2,2,2,4,4,4,6,6,6,...
adblXYArray(iCnt * 2) = Int((iCnt + 2) / 3) * 2
Next iCnt
'Place the shapes. DropMany does all at once...the Main shape and its duplicates. NO naming!!!
intProcessed = ThisDocument.Pages(1).DropMany(varObjectsToInstance, adblXYArray, aintIDArray)
ActiveWindow.Page.CenterDrawing
'Assign name to each shape and display it here.
'This loop gets modified to read name from some place
'NOTE: only name a shape once to avoid issues of "Name" vs "NameU"
iCnt = 1
For Each vShp In ActivePage.Shapes
If Not vShp.OneD Then 'ignore 1D shapes
vShp.Name = "Name_" & iCnt 'the desired name is entered here
' Display shape name
Set vChars = vShp.Characters
vChars.Begin = 0
vChars.End = 0
vChars.AddFieldEx visFCatObject, visFCodeObjectName, visFmtStrNormal, 1033, 0
End If
iCnt = iCnt + 1
Next
Debug.Print "Number of shapes Processed: " & intProcessed
Debug.Print "Shp" & Chr(9) & "ID" & Chr(9) & "Name"
For iCnt = LBound(aintIDArray) To UBound(aintIDArray)
Set vShp = ActivePage.Shapes.ItemFromID(aintIDArray(iCnt))
Debug.Print iCnt & Chr(9) & aintIDArray(iCnt) & Chr(9) & vShp.Name
Next iCnt
End Sub
One more modification. The code does placements for landscape orientation, and places the shapes from left to right, top to bottom.
Sub DupManyLand()
'This macro duplicates a single master / shape on the active page for the desired number of times.
'Both the shape name and number of shapes are hard coded in this code example.
'At the end, in the immediate window, a summary is debug printed
'Code was re-worked from DropMany code example.
Update: The code does landscape orientation, starting left to right, top to bottom.
'Wapperdude
Dim mShp As Visio.Master
Dim iCnt As Integer
Dim numShps As Integer
Dim aintIDArray() As Integer
Dim intProcessed As Integer
Dim vChars As Characters
iCnt = 1
numShps = 15 'Enter number of shapes per page
Set mShp = Documents.Item("DropMany.vsdm").Masters.ItemU("Square")
Debug.Print mShp.Name
ReDim varObjectsToInstance(1 To numShps) As Variant
ReDim adblXYArray(1 To numShps * 2) As Double
'Populate the arrays with main shape(s), location, and shape IDs
For iCnt = 1 To numShps
' Pass name of object to drop to DropMany.
varObjectsToInstance(iCnt) = mShp.Name
'Change following placeme routine as desired
' Set x components of where to drop to 2,4,6,2,4,6,2,4,6,...
adblXYArray(iCnt * 2 - 1) = (((iCnt - 1) Mod 5) + 1) * 2
' Set y components to 2,2,2,4,4,4,6,6,6,...
adblXYArray(iCnt * 2) = 8 - (Int((iCnt + 4) / 5)) * 2
Next iCnt
'Place the shapes
intProcessed = ThisDocument.Pages(1).DropMany(varObjectsToInstance, adblXYArray, aintIDArray)
ActiveWindow.Page.CenterDrawing
'Assign name to shape and display here.
'This loop gets modified to read name from someplace
'Only name a shape once to avoid issues of Name and NameU
iCnt = 1
For Each vShp In ActivePage.Shapes
If Not vShp.OneD Then
vShp.Name = "Name_" & iCnt
Set vChars = vShp.Characters
vChars.Begin = 0
vChars.End = 0
vChars.AddFieldEx visFCatObject, visFCodeObjectName, visFmtStrNormal, 1033, 0
End If
iCnt = iCnt + 1
Next
Debug.Print "Number of shapes Processed: " & intProcessed
Debug.Print "Shp" & Chr(9) & "ID" & Chr(9) & "Name"
For iCnt = LBound(aintIDArray) To UBound(aintIDArray)
Set vShp = ActivePage.Shapes.ItemFromID(aintIDArray(iCnt))
Debug.Print iCnt & Chr(9) & aintIDArray(iCnt) & Chr(9) & vShp.Name & Chr(9) & adblXYArray((iCnt + 1) * 2 - 1) & Chr(9) & adblXYArray((iCnt + 1) * 2)
Next iCnt
End Sub
Thank you will try the code.
As for placement that would be for initial placement as the actual placement of the shapes changes every time the data is updated. the page has time attributes associated with it so each shape is placed on the page relative to its start time. The smart shape then draws itself (makes its height bigger or smaller) based on elapsed time. That way it is easy to see long running processes at a glance.
trying to modify the script to use the master set up for this called 64CharMaster but getting error 'object name not found'. Clearly not the right master to clone from. What is the obvious mistake I am making
' Set mShp = Documents.Item("DropMany.vsdm").Masters.ItemU("Square")
Set mShp = ThisDocument.Masters.ItemU("64CharMaster")
Quote from: visio on March 30, 2023, 03:05:23 PMClearly not the right master to clone from
Master
64CharMaster is exist in
ThisDocument?
I recorded another macro which was just a manual drag and dropof the master onto the page and then used it to target the real master name = Set mShp = Documents.Item("Trilogy.vss").Masters.ItemU("64_Char_Uproc")
Multiple shapes created, only issue is the name of the shapes which is prefixing the new name onto the current name of the master i.e. Name_26aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa64 with the master being called aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa64
Also is it possible to use a test file as a driver file for the copy? So if there is a file with a list of shape names the something lie a for loop with a read at the top might do?
Quote from: visio on March 31, 2023, 02:04:38 PMwith the master being called aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa64
Funny !
Who assign these long names ?
The master name is like that so the shape can be formatted correctly on the page so it looks readible.
Quote from: visio on March 31, 2023, 02:48:00 PMso it looks readible.
(https://sun9-72.userapi.com/impf/c633619/v633619042/3a6dc/dzk2f2CNPIE.jpg?size=130x130&quality=96&sign=ddf44eaa3bf3622f969e7a9e9b186275&c_uniq_tag=QacJiectjBEsbczbeq6Bgaew_RJYt1de1CojkNhiW2c&type=album)
Great !
Quote from: visio on March 31, 2023, 02:04:38 PMused it to target the real master name = Set mShp = Documents.Item("Trilogy.vss").Masters.ItemU("64_Char_Uproc")
Sorry! It is so complex for me...
I agree with Surrogate!
Are these long names being used for growing the width of the shape to accommodate the displayed text?
Check out the following shapesheet functions, which would be used in Text Transform section: Textwidth, Textheight. Then set shape width = txtwidth. This would alleviate need for tediously long names. Forum search ought to provide additional examples.