[已解决]为什么不移动呢~?

 
Public Sub zbzh()
  Dim SSS As AcadSelectionSet '要复制的对象选择集
  Set SSS = ThisDrawing.ActiveSelectionSet
    SSS.Clear
  SSS.SelectOnScreen
  
  Dim BasePnt As Variant '基点
  BasePnt = ThisDrawing.Utility.getpoint(, "指定基点: ")
  Dim TargetPnt As Variant '目标点
  Dim ss(0 To 1) as double
  Dim Obj As AcadObject '源对象
  Dim TargetObj As AcadObject '目标对象
  
  On Error Resume Next
   ss(0)=1500
   ss(1)=1500
Targetpnt=ss
       If Err Then
      ThisDrawing.Regen acActiveViewport '重生成
      Exit Sub
    End If
    '复制并移动对象
    For Each Obj In SSS
      Set TargetObj = Obj.Copy()
     TargetObj.Move BasePnt, TargetPnt
    Next
End Sub

 
Public Sub zbzh()
    Dim SSS As AcadSelectionSet '要复制的对象选择集
    Set SSS = ThisDrawing.ActiveSelectionSet
        SSS.Clear
        SSS.SelectOnScreen
  
    Dim BasePnt As Variant '基点
    BasePnt = ThisDrawing.Utility.GetPoint(, "指定基点: ")
    Dim TargetPnt As Variant '目标点
    Dim ss(0 To 2) As Double
    Dim Obj As AcadObject '源对象
    Dim TargetObj As AcadObject '目标对象
    ss(0) = 1500
    ss(1) = 1500
    ss(2) = 0#
    TargetPnt = ss
    '复制并移动对象
    For Each Obj In SSS
      Set TargetObj = Obj.Copy()
      TargetObj.Move BasePnt, TargetPnt
    Next
End Sub