Change custom properties in shapes

[hendrik]

Hi,

I'm trying to automatically create diagrams based on text file input. I've created a (ungrouped) shape consisting out of multiple lines and boxes and moved it to my document stencil. The text file (CSV) contains whatever the value should be for each of those boxes. I've already figured out how to map custom properties to each of those fields. The problem is that within VBA, I cannot seem to map the text file data to the custom properties for the shapes. It gives me a typical End of File error (which, I gather, points out that the property name could not be found). I'm not sure how I should set the values in the master shape. The same problem seems to occur when I select just the box I want to set the field to (many boxes with each their field), select all the components from my shape and set the field or group everything (in which case I cannot set the individual box fields). I've tried setting the box fields separately and then group but that gives me similar results.

Any help is appreciated! This has been haunting me for a couple of days now 
Thanks

Hendrik

[aledlund]

If you check over here

http://visguy.com/vgforum/index.php?topic=1117.0

in the modShape module you'll find a routine (ForceShapeProperty) that might help

hth,
al

[aledlund]

turns out there may be an issue in v2010 with this code. v2010 doesn't pass the value if they are explicitly defined (i.e. byval something as type).
al

[hendrik]

Thanks for the info, Al.
Below I've posted the code I've been using. It uses a similar approach to setting the formula.

Code Select Expand


Public Sub create_diag()
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Dim fs, f, ts
Dim s As String
Dim i, j As Integer
Dim prev As String
Dim page As Visio.page
Dim shape As Visio.shape
Dim master As Visio.master
Dim cell As Visio.cell
Dim lines(4) As String
Dim ShapeCount As Integer
Dim rec() As String

' Read hostnames from hosts.txt and create worksheet per host

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile("hosts.txt")
Set ts = f.OpenAsTextStream(ForReading, TristateUseDefault)
Do While ts.AtEndOfStream <> True
     s = ts.ReadLine
     Set page = ActiveDocument.Pages.Add
     page.Name = s
Loop
ts.Close

' Read records and add diagrams to respective host worksheet

i = 0
Set f = fs.GetFile("records.txt")
Set ts = f.OpenAsTextStream(ForReading, TristateUseDefault)
Set master = ActiveDocument.Masters("Connection")
Do While ts.AtEndOfStream <> True
     lines(1) = ts.ReadLine
     ' Each record is 4 lines
     lines(2) = ts.ReadLine
     lines(3) = ts.ReadLine
     lines(4) = ts.ReadLine
     ' Host is first entry of CSV record
     rec = Split(lines(1), ":")

     ' Reset i if worksheet changes
     If (prev <> rec(0)) Then
     i = 0
     Set page = ActiveDocument.Pages.Item(rec(0))
     Else
     i = i + 1.1
     End If
     ' Use shape from stencil and drop it at position 4.5:i
     Set shape = page.Drop(master, 4.5, i)
     Set cell = shape.cells("Prop.HostField")
     cell.Formula = Chr(34) & rec(0) & Chr(34)
     ' Set value as "hostname"
     prev = rec(0)
Loop
ts.Close
 
End Sub


The hostname file contains one host per file, the CSV file contains 4 lines per record, multiple records per host. So basically, every worksheet represents one host. I'm using Visio 2003 Pro. The error dialog indicates "Unexpected End of File". Any hints?

Thanks
Hendrik

[aledlund]

It is often good programming to always test that a cell exists before attempting to select it and change it. That's why I referenced you to the example code (if it doesn't find the custom property it will create it first, so you don't get an end of file). I ended up reposting it for another user

http://visguy.com/vgforum/index.php?topic=1233.msg5302;topicseen#msg5302

al

[aledlund]

The other possiblility that I noticed is that you don't check to see the 'master' shape you select from the activedocument is returning a valid shape?

Is the activedocument a stencil, or the drawing, your code doesn't show a stencil document being selected.

al

[hendrik]

I finally fixed it a few days ago and I didn't want to keep this from everyone.
Pardon my sloppy coding style and typos... I cleaned up the irrelevant bits

Code Select Expand


Public Sub create_pages(infile As String)
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Dim fs, f, ts
Dim s As String
Dim page As Visio.page
 
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(infile)
Set ts = f.OpenAsTextStream(ForReading, TristateUseDefault)
Do While ts.AtEndOfStream <> True
     s = ts.ReadLine
     Set page = ActiveDocument.Pages.Add
     page.Name = s
Loop
ts.Close

End Sub

' This procedure will create shapes based on file input from selectionnames.short.txt
' Expected input: 4 QoS lines per circuit
' Expected format: hostname:selectionname for QOS:

Public Sub generate_diag(infile As String)
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Dim fs, f, ts
Dim i, j, ShapeCount As Integer
Dim y As Integer
Dim s, lowsidehost, highsidehost As String
Dim page As Visio.page
Dim shape, subshape As Visio.shape
Dim master As Visio.master
Dim cell As Visio.cell
Dim lines(4) As String
Dim rec() As String

i = page.PageSheet.Cells("PageHeight")
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(infile)
Set ts = f.OpenAsTextStream(ForReading, TristateUseDefault)
Set master = ActiveDocument.Masters("Diag")
Do While ts.AtEndOfStream <> True
     lines(1) = ts.ReadLine
     lines(2) = ts.ReadLine
     lines(3) = ts.ReadLine
     lines(4) = ts.ReadLine
     rec = Split(lines(1), ":")
     lowsidehost = rec(0)
     highsidehost = rec(1)
     
     i = i - 1.25
     Set shape = page.Drop(master, 4.15, i)
     For Each subshape In shape.Shapes
       If subshape.CellExists("Prop.LowSideHost.Value", 0) Then
         subshape.Cells("Prop.LowSideHost.Value").Formula = Chr(34) & lowsidehost & Chr(34)
       End If
       
       If subshape.CellExists("Prop.HighSideHost.Value", 0) Then
         subshape.Cells("Prop.HighSideHost.Value").Formula = Chr(34) & highsidehost & Chr(34)
       End If

     Next
     
Loop
ts.Close
 
End Sub