Sub Test() Dim shp1 As Shape, shp2 As Shape Set shp1 = ActiveLayer.CreateRectangle2(0, 0, 5, 2.5) Set shp2 = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, _ shp1.SnapPoints(1), shp1.SnapPoints(3)) shp2.Dimension.Outline.Color = CreateRGBColor(255,0,0)End Sub