points property of shapes.nodes

[Dave S]

I'm trying to return the node points of a freeform shape.
I've keep getting 'type mismatch error'.

Dim Tbox As Shape
Dim Pict As InlineShape
Dim x As Single
Dim y As Single
Dim J As Integer
Dim pointsArray As Variant

For Each Pict In ActiveDocument.InlineShapes
Pict.Select
Pict.Activate
For Each Tbox In ActiveDocument.Shapes
If UCase(Left(Tbox.Name, 9)) = "FREEFORM " Then
Tbox.Select
For J = 1 To Tbox.Nodes.Count
ReDim pointsArray(0 To Tbox.Nodes.Count - 1, 0 To 1)
pointsArray = Tbox.Nodes(J).Points 'Error occurs here
x = pointsArray(J, 0)
y = pointsArray(J, 1)
Next J
x = Tbox.Name
End If
Next Tbox
ActiveDocument.Close
Next Pict

Points is supposed to return a coordinate pair.
I've tried Dim as single, double, int, variant, no Dim,
Dim pointsArray(), etc.
I've also tried every concievable permutation of
dimensions in the redim. The example given in the help
doesn't work. Is this a bug?
Help!

 

[JGM]

Hi Dave,

I found two problems with your procedure:
1)

For J = 1 To Tbox.Nodes.Count
ReDim pointsArray(0 To Tbox.Nodes.Count - 1, 0 To 1)

Please someone, correct me if I am wrong, but I think that as written, your
code will redefine the array "pointsArray" everytime J is increased, thereby
losing all previous information in the array. You either have to Redim the
array before the loop, or define it as way too big before the loop, and do a
Redim Preserve after the loop, in which case you have to be careful because
Redim in a multidimensional array will only redefine the last dimension (or
last column). Anyway, look at what I have done, this will give you some
ideas as to what you can do.

2)
I do not know why, but if you Dim some object as Document or Shape, as in

Dim Tbox As Shape

the code will not work and you get the error message you got!
If someone could explain this one, I would be very interested!

I give you an example that worked on my machine (Office XP) with a document
having a freeform in it... I did not bother to test for Inlineshape and all
that. Anyway, I hope my example will help you move along with your project.

HTH
Cheers.

_______________________________________
Dim x As Single
Dim y As Single
Dim J As Integer
Dim pointsArray As Variant
Dim myResults As String

Set myDoc = ActiveDocument

For Each myShape In myDoc.Shapes

If UCase(Left(myShape.Name, 9)) = "FREEFORM " Then

Set Tbox = myShape
ReDim pointsArray(1 To Tbox.Nodes.Count, 1 To 2)

For J = 1 To Tbox.Nodes.Count

With Tbox.Nodes
wdpointsarray = .Item(J).Points
pointsArray(J, 1) = _
Round(PointsToInches(wdpointsarray(1, 1)), 2)
pointsArray(J, 2) = _
Round(PointsToInches(wdpointsarray(1, 2)), 2)
x = pointsArray(J, 1)
y = pointsArray(J, 2)
End With

Next J

myResults = "Here are the coordinates in inches" _
& vbCrLf & "for all nodes (x - y) in the shape named" _
& vbCrLf & Tbox.Name & ":" & vbCrLf & vbCrLf
For i = 1 To Tbox.Nodes.Count
myResults = myResults & "Point #" & i & " = " _
& pointsArray(i, 1) & " - " & pointsArray(i, 2) & vbCrLf
Next i

MsgBox myResults

End If

Next myShape
_______________________________________

 

[Guest]

I tried your solution and it worked!! Super! The redim
thing was just trying to get it to work, I know I couldn't
leave it in the loop.

Once I got it to work, I tracked down the root of the
cause: It's the Dim Tbox as Shape. Switch to Dim TBox as
Variant and it works. Another Microsoft "feature".

You're a genius!

Dave