Sub Test() Dim shp1 As Shape, shp2 As Shape Set shp1 = ActiveLayer.CreateRectangle2(0, 0, 100, 50) Set shp2 = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, shp1.SnapPoints(1), shp1.SnapPoints(3)) Set shp2.Dimension.Linear.Point1 = shp1.SnapPoints(2) Set shp2.Dimension.Linear.Point2 = shp1.SnapPoints(4)