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"
Simply try:
Sub Test()Dim OriUnit As LongOriUnit = ActiveDocument.UnitActiveDocument.Unit = cdrInch
' ....
ActiveDocument.Unit = OriUnitEnd Sub
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.