Sub Macro2() Dim OS As Shape, x#, y#, w#, h# Set OS = ActiveSelection.Shapes(1) For i = 1 To OS.Curve.Segments.Count If OS.Curve.Segments(i).Selected = True Then OS.Curve.Segments(i).GetBoundingBox x, y, w, h MsgBox ("Segment Index = " & i & vbCr & "Width = " & w & vbCr & "Height = " & h & vbCr & "Length = " & OS.Curve.Segments(i).Length) End If Next iEnd Sub
Thanks Mek, not quite there though. Segment width should be 3"
Don't know, if I got your problem correct, maybe this will help:
Sub Test01()Dim CurSh As Shape, SubSh As Shape, i As Integer, MaxS As Double, MaxP As IntegerDim MyCrv As Curve, MyPath As SubPathSet CurSh = ActiveShapeFor i = 2 To CurSh.Curve.SubPaths.Count If i = 2 Then MaxS = CurSh.Curve.SubPaths(i).Area MaxP = i Else If CurSh.Curve.SubPaths(i).Area > MaxS Then MaxS = CurSh.Curve.SubPaths(i).Area MaxP = i End If End IfNext iSet MyCrv = ActiveDocument.CreateCurveMyCrv.AppendCurve CurSh.Curve.SubPaths(MaxP).GetCopySet SubSh = ActiveLayer.CreateCurve(MyCrv)SubSh.Fill.ApplyUniformFill CreateRGBColor(255, 0, 0)MsgBox "My Size is " + Format(MaxS, "0.000")SubSh.DeleteCurSh.Selected = TrueEnd Sub
hmmm. Size still off and still need both width & height.
Also it only works one time. If I marquee select another round of nodes it still wants to calculate from the first run.
Hope, I got it right now: You want to select one of the 'holes' and get the dimension (W/H) of it. If yes, this will work (hopefully):
Sub Test01()Dim CurSh As Shape, SubSh As Shape, i As Integer, MaxS As Double, MaxP As IntegerDim MyCrv As Curve, MyPath As SubPathDim x As Double, y As DoubleSet CurSh = ActiveShapex = CurSh.Curve.Selection.BoundingBox.Lefty = CurSh.Curve.Selection.BoundingBox.TopMaxP = 0For i = 1 To CurSh.Curve.SubPaths.Count If CurSh.Curve.SubPaths(i).IsOnSubPath(x, y) Then MaxP = iNext iIf MaxP = 0 Then MsgBox "Nothing found"Else With CurSh.Curve.SubPaths(MaxP).BoundingBox MsgBox Format(ConvertUnits(.Width, ActiveDocument.Unit, cdrInch), "0.00") + """ wide and " _ + Format(ConvertUnits(.Height, ActiveDocument.Unit, cdrInch), "0.00") + """ high" End WithEnd IfEnd Sub
Note the Function ConvertUnits: So you don't have to switch the Document.Unit anymore
Yep! Just modified the format a bit to my liking. Thanks NudeFan. Where do I send the beer?[B]
oops! Just created a shape to test. Works on some SubPaths but others it returns the dimensions of the whole shape and not just the selected SubPath.[:(]
never mind, Found that culprit! Loop in the line segment.