Private Sub ll2()

   Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

       Set SwApp = Application.SldWorks

       Set SwModel = SwApp.ActiveDoc

   Dim SwSelMgr As SelectionMgr, Str

       Set SwSelMgr = SwModel.SelectionManager

   Dim SwDim As Dimension, SwDispDim As DisplayDimension

       ''

       For ii = 1 To 20

           Set SwDispDim = SwSelMgr.GetSelectedObject5(ii)

           If Not SwDispDim Is Nothing Then

               Set SwDim = SwDispDim.GetDimension

               Str = SwDim.FullName

               Str = Left(Str, InStrRev(Str, "@") - 1)

               SwDim.Name = "DrwDim" & Str

           End If

       Next ii

End Sub