单行文字自动等行间距布置问题
本帖最后由 作者 于 2008-6-2 15:30:29 编辑 <br /><br /> <p>众多的单行文字希望它们能根据输入的间距值自动值调整布置（行与行之间的先后顺序不能变），我写了以下代码，大致思路是先读取选择集，然后根据各个单行文字的Y坐标值进行数组排列，最后一一布置。但是我的代码还是有问题，尽管我多选择集中的单行文字进行了排列，但是最后布置下来还是出现了行行之间先后顺序变化的情况，希望高手给看一下，小弟先谢过了。</p><p>Private Sub CommandButton13_Click()<br/> Dim enttemp As AcadText<br/> Dim ents() As AcadText<br/> Dim InsertP(0 To 2) As Double<br/> Dim InsertPv1 As Variant<br/> Dim InsertPv2 As Variant<br/> Dim name As String<br/> Dim dimension As AcadDimension<br/> Dim fType, fData<br/> Dim tzs As Integer<br/> Dim selectsets As AcadSelectionSets<br/> Dim ssetObj As AcadSelectionSet<br/> Dim leng As Double<br/> Dim i As Integer<br/> Dim j As Integer<br/> Me.Hide<br/> On Error Resume Next<br/> leng = CDbl(InputBox("请输入行间距", "间距值输入", 800)) '输入行间距<br/> Set selectsets = ThisDrawing.SelectionSets<br/> selectsets.Item("jack").Delete<br/> Set ssetObj = selectsets.Add("jack") '创建选择集<br/> BuildFilter fType, fData, 0, "Text" '创建选择过滤<br/> ssetObj.SelectOnScreen fType, fData '在屏幕上选择对象<br/> tzs = ssetObj.count<br/> ReDim ents(tzs - 1) As AcadText<br/> '先读取所有单行文字，并根据其所在点的坐标（Y坐标）进行从大到小的排列<br/> '读取<br/> For i = 0 To tzs - 1<br/> Set ents(i) = ssetObj.Item(i)<br/> ents(i).Alignment = acAlignmentLeft<br/> Next<br/> '排序<br/> For i = 0 To tzs - 2<br/> InsertPv1 = ents(i).InsertionPoint<br/> For j = i + 1 To tzs - 1<br/> InsertPv2 = ents(j).InsertionPoint<br/> If CDbl(InsertPv2(1)) >= CDbl(InsertPv1(1)) Then<br/> Set enttemp = ents(i)<br/> Set ents(i) = ents(j)<br/> Set ents(j) = enttemp</p><p><font color="#ff0033"> InsertPv1 = ents(i).InsertionPoint '这一句非常重要！！（花了我10天的时间去调试，就是因为少了这一句）</font><br/> End If<br/> Next j<br/> Next i<br/> '均分并排列<br/> For i = 0 To tzs - 1<br/> If i = 0 Then<br/> InsertPv2 = ents(i).InsertionPoint<br/> InsertP(0) = InsertPv2(0)<br/> InsertP(1) = InsertPv2(1)<br/> InsertP(2) = InsertPv2(2)<br/> Else<br/> InsertP(1) = InsertP(1) - leng<br/> ents(i).InsertionPoint = InsertP<br/> ents(i).Update<br/> End If<br/> Next<br/> Me.Show<br/>End Sub</p> 三天的全国哀悼日都已经过去了，我等这个帖子的回复也等了三天，高手们，你们在哪里？快来看看小弟的这个问题吧。我在线等你们啊，就像灾区人民期待救援人员多救一个幸存者一样，期待！ <p>我初学，对lisp了解多些。</p><p>我曾经用lisp编写了类似的程序，但对部分单行文字，好像不管用，会将顺序打乱</p><p>我在《AutoCAD VBA 二次开发教程》中找到了一个程序，对那些单行文字也不管用，仍然会将顺序打乱</p><p>迷惑ing</p><p>这是《AutoCAD VBA 二次开发教程》自带光盘中的程序</p> 《AutoCAD VBA 二次开发教程》里有一点错误。我记不请了，你分析一下代码找找问题，好想是坐标的问题，改后就行了。 换种排序方法试试？ 感谢楼上几位回帖的兄弟！我怎么看我的代码都没有错，也试了好多遍，基本上是逐句逐句的试验了，Y坐标在排列前好好的，等排序完了，硬是把我的某些行顺序给换了（坐标值大的往下跑，小的反而往上跑），我查了我的排序运算也没有错啊，真是郁闷。我后来还请教过我们总工，他做成功了，但是他不是采用的对象数组的办法，所以我在怀疑是不是这个对象数组在排序的过程中会出错？？我继续试验，等成功了把代码发上来大家共享一下，也希望大家都帮忙试试，谢谢！ 你把单行文字的坐标改了，文字当然会改变位置。排序的关键是选择集的顺序要按单行文字的Y坐标排序.可以新建个选择集.找到最小坐标的单行文字,按顺序存入新建的选择集. <p> Set enttemp = ents(i)<br/> Set ents(i) = ents(j)<br/> Set ents(j) = enttemp </p><p>把上面的改成这试试 </p><p>Set enttemp = ssetObj.Item(i)</p><p>set ssetobj.Item(i)=ssetobj.Item(j)</p><p>set ssetobj.Item(j)=enttemp</p><p> <br/></p> <p>我一般把对象和坐标包含在一个三维数组中，</p><p>在我的一个小工具中没有什么问题。</p><p></p><p>lz可以试着debug一下在哪个语句过程中，顺序被调换，然后再找原因。</p> <p>真的很感谢所有回帖的朋友们，我很高兴的告诉大家，我的问题已经解决了，昨晚上搞到凌晨终于弄明白出错的地方了，为了感谢大家，将问题公布一下，让所有的人都能引以为戒</p><p>这段代码的思路是没有错的，错在排序算法的语句，这个问题跟普通“冒泡法”排序不太一样，少了一句非常关键的语句，详见我的原帖，估计内行的一看就知道了，我就不详细说了。</p>
页:
[1]
2