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

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

你试试，可以啊

su37 发表于 2010-12-22 09:07:00

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

su37 发表于 2010-12-24 20:09:00

没人知道么？

su37 发表于 2010-12-26 08:10:00

没人知道么？

su37 发表于 2010-12-26 20:31:00

乐筑天下这么冷清这么冷清啊？
高水都到哪去了

sxpd 发表于 2010-12-26 22:46:00

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

页: [1]

乐筑天下's Archiver

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