哪位高手有CAD对象按坐标排序的代码？

dong20030432

我自己用VB做了一个文字排列并调整间距的小程序，直接对选择集内对象逐一按坐标进行移动，会将原有顺序打乱 ，哪位高手有选择集内对象按坐标排序的代码（或者能够解决这个问题的方法），能否共享一下，非常感谢！

zzyong00

http://bbs.mjtd.com/thread-111364-1-1.html

dong20030432

自己在教程里面找到了，感谢大家！！！

dong20030432

zzyong00 发表于 2018-1-23 16:34
http://bbs.mjtd.com/thread-111364-1-1.html

虽然我已经在《AutoCAD VBA二次开发教程》中找到类似方法了，但仍然感谢您的回答，感谢您的原代码！！！

dong20030432

zzyong00 发表于 2018-1-23 16:34
http://bbs.mjtd.com/thread-111364-1-1.html

程序大概看了一下，没怎么看明白，怎么感觉不是我想要的效果呢（可能是我水平有限，或者没说明清楚问题吧）。我要的是把文字对象排序后，移动文字，保证其初始顺序不变。如果你的函数可以实现，请告诉我一下我的选择集怎么和你的XY_soft函数（函数需要的参数是数组，我是不是要先把选择集转换成数组？）结合起来，谢谢了！

dong20030432

zzyong00 发表于 2018-1-23 16:34
http://bbs.mjtd.com/thread-111364-1-1.html

我是要把选择集中的对象按坐标排序，然后对其进行移动，并同时调整间距，而不破坏原始先后顺序，即按插入点自动对齐。你的函数能实现吗？

dong20030432

zzyong00 发表于 2018-1-23 16:34
http://bbs.mjtd.com/thread-111364-1-1.html

这是我的代码，要实现文字按行对齐，即所有文字y坐标相同， x坐标等间距分布，帮忙看下怎么能保证文字对象初始相对顺序不乱序，谢谢！

2. On Error Resume Next
   
3.     If Not IsNull(acadapp.ActiveDocument.SelectionSets.Item("ss1")) Then
   
4.     Set sset = acadapp.ActiveDocument.SelectionSets.Item("ss1")
   
5.     sset.Delete
   
6.     End If
   
7.     Set sset = acadapp.ActiveDocument.SelectionSets.Add("ss1")
   
8.     Call CreateSSetFilter(fType, fDate, 0, "text")
   
9.     AppActivate acadapp.Caption
   
10.     sset.SelectOnScreen fType, fDate
    
11.     Call ShowSelectionSetCrips(sset)
    
12.     For i = 0 To sset.Count - 1
    
13.     If sset.Count = 1 Then Exit Sub
    
14.         If sset.Count > 1 Then
    
15.             If i = 0 Then
    
16.             myPoint = sset.Item(0).InsertionPoint
    
17.             End If
    
18.             If i > 0 Then
    
19.             myPoint = sset.Item(i - 1).InsertionPoint
    
20.             sset.Item(i).GetBoundingBox pMin, pMax
    
21.             dyPoint = sset.Item(i).InsertionPoint
    
22.             xPoint(0) = myPoint(0) + Val(m.Text4.Text) + pMax(0) - pMin(0)
    
23.             xPoint(1) = myPoint(1)
    
24.             xPoint(2) = dyPoint(2)
    
25.             sset.Item(i).Move dyPoint, xPoint
    
26.             sset.Item(i).Update
    
27.             End If
    
28.         End If
    
29.     Next
    
30.     sset.Delete

On Error Resume Next<br />     If Not IsNull(acadapp.ActiveDocument.SelectionSets.Item("ss1")) Then<br />     Set sset = acadapp.ActiveDocument.SelectionSets.Item("ss1")<br />     sset.Delete<br />     End If<br />     Set sset = acadapp.ActiveDocument.SelectionSets.Add("ss1")<br />     Call CreateSSetFilter(fType, fDate, 0, "text")<br />     AppActivate acadapp.Caption<br />     sset.SelectOnScreen fType, fDate<br />     Call ShowSelectionSetCrips(sset)<br />     For i = 0 To sset.Count - 1<br />     If sset.Count = 1 Then Exit Sub<br />         If sset.Count > 1 Then<br />             If i = 0 Then<br />             myPoint = sset.Item(0).InsertionPoint<br />             End If<br />             If i > 0 Then<br />             myPoint = sset.Item(i - 1).InsertionPoint<br />             sset.Item(i).GetBoundingBox pMin, pMax<br />             dyPoint = sset.Item(i).InsertionPoint<br />             xPoint(0) = myPoint(0) + Val(m.Text4.Text) + pMax(0) - pMin(0)<br />             xPoint(1) = myPoint(1)<br />             xPoint(2) = dyPoint(2)<br />             sset.Item(i).Move dyPoint, xPoint<br />             sset.Item(i).Update<br />             End If<br />         End If<br />     Next<br />     sset.Delete

zzyong00

我的代码就是“对象按坐标排序的代码”

dong20030432

zzyong00 发表于 2018-1-23 23:07
我的代码就是“对象按坐标排序的代码”

能帮忙看下你的代码和我的代码怎么组合成一段完整代码吗？我初学，不是很明白，麻烦您了！