单行文字自动等行间距布置问题

czh415

众多的单行文字希望它们能根据输入的间距值自动值调整布置（行与行之间的先后顺序不能变），我写了以下代码，大致思路是先读取选择集，然后根据各个单行文字的Y坐标值进行数组排列，最后一一布置。但是我的代码还是有问题，尽管我多选择集中的单行文字进行了排列，但是最后布置下来还是出现了行行之间先后顺序变化的情况，希望高手给看一下，小弟先谢过了。

Private Sub CommandButton13_Click()
    Dim enttemp As AcadText
    Dim ents() As AcadText
    Dim InsertP(0 To 2) As Double
    Dim InsertPv1 As Variant
    Dim InsertPv2 As Variant
    Dim name As String
    Dim dimension As AcadDimension
    Dim fType, fData
    Dim tzs As Integer
    Dim selectsets As AcadSelectionSets
    Dim ssetObj As AcadSelectionSet
    Dim leng As Double
    Dim i As Integer
    Dim j As Integer
    Me.Hide
    On Error Resume Next
    leng = CDbl(InputBox("请输入行间距", "间距值输入", 800)) '输入行间距
    Set selectsets = ThisDrawing.SelectionSets
    selectsets.Item("jack").Delete
    Set ssetObj = selectsets.Add("jack") '创建选择集
    BuildFilter fType, fData, 0, "Text" '创建选择过滤
    ssetObj.SelectOnScreen fType, fData '在屏幕上选择对象
    tzs = ssetObj.count
    ReDim ents(tzs - 1) As AcadText
    '先读取所有单行文字，并根据其所在点的坐标（Y坐标）进行从大到小的排列
    '读取
    For i = 0 To tzs - 1
        Set ents(i) = ssetObj.Item(i)
        ents(i).Alignment = acAlignmentLeft
    Next
    '排序
    For i = 0 To tzs - 2
        InsertPv1 = ents(i).InsertionPoint
        For j = i + 1 To tzs - 1
            InsertPv2 = ents(j).InsertionPoint
            If CDbl(InsertPv2(1)) >= CDbl(InsertPv1(1)) Then
                Set enttemp = ents(i)
                Set ents(i) = ents(j)
                Set ents(j) = enttemp

                InsertPv1 = ents(i).InsertionPoint '这一句非常重要！！（花了我10天的时间去调试，就是因为少了这一句）
            End If
        Next j
    Next i
    '均分并排列
    For i = 0 To tzs - 1
        If i = 0 Then
            InsertPv2 = ents(i).InsertionPoint
            InsertP(0) = InsertPv2(0)
            InsertP(1) = InsertPv2(1)
            InsertP(2) = InsertPv2(2)
        Else
            InsertP(1) = InsertP(1) - leng
            ents(i).InsertionPoint = InsertP
            ents(i).Update
        End If
    Next
    Me.Show
End Sub

czh415

三天的全国哀悼日都已经过去了，我等这个帖子的回复也等了三天，高手们，你们在哪里？快来看看小弟的这个问题吧。我在线等你们啊，就像灾区人民期待救援人员多救一个幸存者一样，期待！

jancely

[CODE]

我初学，对lisp了解多些。

我曾经用lisp编写了类似的程序，但对部分单行文字，好像不管用，会将顺序打乱

我在《AutoCAD VBA 二次开发教程》中找到了一个程序，对那些单行文字也不管用，仍然会将顺序打乱

迷惑ing

这是《AutoCAD VBA 二次开发教程》自带光盘中的程序

hbyu2003

《AutoCAD VBA 二次开发教程》里有一点错误。我记不请了，你分析一下代码找找问题，好想是坐标的问题，改后就行了。

xxxtttxxx

换种排序方法试试？

czh415

感谢楼上几位回帖的兄弟！我怎么看我的代码都没有错，也试了好多遍，基本上是逐句逐句的试验了，Y坐标在排列前好好的，等排序完了，硬是把我的某些行顺序给换了（坐标值大的往下跑，小的反而往上跑），我查了我的排序运算也没有错啊，真是郁闷。我后来还请教过我们总工，他做成功了，但是他不是采用的对象数组的办法，所以我在怀疑是不是这个对象数组在排序的过程中会出错？？我继续试验，等成功了把代码发上来大家共享一下，也希望大家都帮忙试试，谢谢！

hbyu2003

你把单行文字的坐标改了，文字当然会改变位置。排序的关键是选择集的顺序要按单行文字的Y坐标排序.可以新建个选择集.找到最小坐标的单行文字,按顺序存入新建的选择集.

hbyu2003

 Set enttemp = ents(i)
 Set ents(i) = ents(j)
 Set ents(j) = enttemp  

把上面的改成这试试             

Set enttemp = ssetObj.Item(i)

set ssetobj.Item(i)=ssetobj.Item(j)

set ssetobj.Item(j)=enttemp

                   

xxxtttxxx

我一般把对象和坐标包含在一个三维数组中，

在我的一个小工具中没有什么问题。

lz可以试着debug一下在哪个语句过程中，顺序被调换，然后再找原因。

czh415

真的很感谢所有回帖的朋友们，我很高兴的告诉大家，我的问题已经解决了，昨晚上搞到凌晨终于弄明白出错的地方了，为了感谢大家，将问题公布一下，让所有的人都能引以为戒

这段代码的思路是没有错的，错在排序算法的语句，这个问题跟普通“冒泡法”排序不太一样，少了一句非常关键的语句，详见我的原帖，估计内行的一看就知道了，我就不详细说了。