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

chenmo7758

3. Public Sub zbzh()
4.   Dim SSS As AcadSelectionSet '要复制的对象选择集
5.   Set SSS = ThisDrawing.ActiveSelectionSet
6.     SSS.Clear
7.   SSS.SelectOnScreen
8.   
9.   Dim BasePnt As Variant '基点
10.   BasePnt = ThisDrawing.Utility.getpoint(, "指定基点: ")
11.   Dim TargetPnt As Variant '目标点
12.   Dim ss(0 To 1) as double
13.   Dim Obj As AcadObject '源对象
14.   Dim TargetObj As AcadObject '目标对象
15.   
16.   On Error Resume Next
17.    ss(0)=1500
18.    ss(1)=1500
19. Targetpnt=ss
20.        If Err Then
21.       ThisDrawing.Regen acActiveViewport '重生成
22.       Exit Sub
23.     End If
24.     '复制并移动对象
25.     For Each Obj In SSS
26.       Set TargetObj = Obj.Copy()
27.      TargetObj.Move BasePnt, TargetPnt
28.     Next
29. 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 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

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

3. Public Sub zbzh()
4.     Dim SSS As AcadSelectionSet '要复制的对象选择集
5.     Set SSS = ThisDrawing.ActiveSelectionSet
6.         SSS.Clear
7.         SSS.SelectOnScreen
8.   
9.     Dim BasePnt As Variant '基点
10.     BasePnt = ThisDrawing.Utility.GetPoint(, "指定基点: ")
11.     Dim TargetPnt As Variant '目标点
12.     Dim ss(0 To 2) As Double
13.     Dim Obj As AcadObject '源对象
14.     Dim TargetObj As AcadObject '目标对象
15.     ss(0) = 1500
16.     ss(1) = 1500
17.     ss(2) = 0#
18.     TargetPnt = ss
19.     '复制并移动对象
20.     For Each Obj In SSS
21.       Set TargetObj = Obj.Copy()
22.       TargetObj.Move BasePnt, TargetPnt
23.     Next
24. 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

chenmo7758

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

lzx838

加入 明经官方AutoCAD.net QQ群:2474812