求助，请帮忙！关于用程序移动多个对象.

dyerswang

为了方便工作，准备写一个小程序，主要就是先运行，再在屏幕上选择多个对象，再选择一个基点，再选择第二个点，将选择的这些对象以第一个点为基点移动至第二个点。

我试了可以用AcadSelectionset 选择集来实现，但选择集好象最大Item为257个，超过257个就不行了。

请那位高手指点指点，如果在屏幕上同时选择257个以上对象，并移动。

谢谢！

dyerswang

不要用sendcommand 来发送move命令，不需要作成像move命令一样。只需要告诉我如何选择，怎么移动。

再次感谢。

henanlypl

Sub MoveEnt()
    Dim Objentity As AcadEntity
    Dim Sset As AcadSelectionSet
'    On Error Resume Next
    If Not IsNull(ThisDrawing.SelectionSets.Item("ss1")) Then
        Set Sset = ThisDrawing.SelectionSets.Item("ss1")
        Sset.Delete
    End If
    Set Sset = ThisDrawing.SelectionSets.Add("ss1")
   
    Dim Pt1 As Variant
    Dim Pt2 As Variant
    Pt1 = ThisDrawing.Utility.GetPoint(, "请选择第一点")
    Pt2 = ThisDrawing.Utility.GetPoint(, "请选择第二点")
    Sset.SelectOnScreen
    For Each Objentity In Sset
        Objentity.Move Pt1, Pt2
    Next
    MsgBox Sset.Count
   
End Sub

 

你试试，可以啊

su37

有谁知道上面这段程序怎么用？
存储成什么格式？输入哪个按键能调用这个命令
谢谢！！

su37

没人知道么？

su37

没人知道么？

su37

明经这么冷清这么冷清啊？
高水都到哪去了

sxpd

高手都搞高端的.Net去了，VBA已经没落了。。。
这个是宏，直接在Cad里运行