Sub Test() 
 Const NumLines As Long = 20 
 Dim s As Shape 
 Dim pwc As PowerClip 
 Dim x As Double, y As Double, sx As Double, sy As Double 
 Dim xx As Double 
 Dim n As Long 
 For Each s In ActivePage.Shapes 
  Set pwc = Nothing 
  On Error Resume Next 
  Set pwc = s.PowerClip 
  On Error GoTo 0 
  If Not pwc Is Nothing Then 
   s.CreateSelection 
   s.GetBoundingBox x, y, sx, sy 
   pwc.EnterEditMode 
   For n = 1 To NumLines 
    xx = x + n * sx / (NumLines + 1) 
    ActiveLayer.CreateLineSegment xx, y, xx, y + sy 
   Next n 
   pwc.LeaveEditMode 
  End If 
 Next s 
End Sub