|
|
众多的单行文字希望它们能根据输入的间距值自动值调整布置（行与行之间的先后顺序不能变），我写了以下代码，大致思路是先读取选择集，然后根据各个单行文字的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
|
|
置顶卡
请点击此处下载
