Attribute VB_Name = "WYMIAROWANIE" Sub WYMIAR_START() Dim x As Double, Y As Double, sx As Double, sy As Double Dim pt1 As SnapPoint, pt2 As SnapPoint Dim s As Shape ActiveSelection.GetBoundingBox x, Y, sx, sy, False Set pt1 = CreateSnapPoint(x, Y - 3) Set pt2 = CreateSnapPoint(x + sx, Y - 3) Set s = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pt1, pt2, True, , , cdrDimensionStyleDecimal, Units:=cdrDimensionUnitMM) s.Dimension.TextShape.SetPosition x + sx / 2, Y - 3 Set pt1 = CreateSnapPoint(x + sx + 3, Y) Set pt2 = CreateSnapPoint(x + sx + 3, Y + sy) Set s = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pt1, pt2, True, , , cdrDimensionStyleDecimal, 2, True, Units:=cdrDimensionUnitMM, Placement:=cdrDimensionWithinLine) s.Dimension.TextShape.SetPosition x + sx + 3, Y + sx / 2 End Sub Sub WYMIARPLUS_START() Dim x As Double, Y As Double, sx As Double, sy As Double Dim pt1 As SnapPoint, pt2 As SnapPoint Dim s As Shape ActiveSelection.GetBoundingBox x, Y, sx, sy, True Set pt1 = CreateSnapPoint(x, Y - 3) Set pt2 = CreateSnapPoint(x + sx, Y - 3) Set s = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pt1, pt2, True, , , cdrDimensionStyleDecimal, Units:=cdrDimensionUnitMM) s.Dimension.TextShape.SetPosition x + sx / 2, Y - 3 Set pt1 = CreateSnapPoint(x + sx + 3, Y) Set pt2 = CreateSnapPoint(x + sx + 3, Y + sy) Set s = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pt1, pt2, True, , , cdrDimensionStyleDecimal, 2, True, Units:=cdrDimensionUnitMM, Placement:=cdrDimensionWithinLine) s.Dimension.TextShape.SetPosition x + sx + 3, Y + sx / 2 End Sub