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

dyerswang · 发表于 2010-2-26 11:08:00

为了方便工作，准备写一个小程序，主要就是先运行，再在屏幕上选择多个对象，再选择一个基点，再选择第二个点，将选择的这些对象以第一个点为基点移动至第二个点。
我试了可以用AcadSelectionset 选择集来实现，但选择集好象最大Item为257个，超过257个就不行了。
请那位高手指点指点，如果在屏幕上同时选择257个以上对象，并移动。
谢谢！

dyerswang · 发表于 2010-2-26 11:33:00

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

henanlypl · 发表于 2010-6-10 17:01:00

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

你试试，可以啊