chenmo7758 发表于 2010-6-2 13:13:00

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


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

高手帮我看看   为什么不能移动到(1500,1500)点呢~?

lzx838 发表于 2010-6-2 16:00:00

CAD的坐标点是三维的
把Dim ss(0 To 1) as double改成Dim ss(0 To 2) as double


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

chenmo7758 发表于 2010-6-3 16:56:00

哇`~太谢谢你啦`~~~~给俺留个QQ号好吗~?~?我的是877892380

lzx838 发表于 2010-6-4 13:42:00

加入 明经官方AutoCAD.net QQ群:2474812
页: [1]
查看完整版本: [已解决]为什么不移动呢~?