请高手指点一下本人编的小程序

h289990416

帮忙看一下我这个程序，刚一运行，就显示“当前范围内的声明重复”，这是在
AutoCAD中加载VBA的
谢谢了！

3. Option Explicit
4. Public Sub MtextToText()
5.     On Error Resume Next
6.    
7.     Dim ptInsert As Variant
8.     Dim txtStr As String
9.     Dim height As Double
10.     Dim width As Double
11.    
12.     '选择多行文字*********************************************
13.     '安全创建选择集
14.     Dim SSet As AcadSelectionSet
15.     If Not IsNull(ThisDrawing.SelectionSets.Item("this")) Then
16.         Set SSet = ThisDrawing.SelectionSets.Item("this")
17.         SSet.Delete
18.     End If
19.     Set SSet = ThisDrawing.SelectionSets.Add("this")
20.    
21.     '定义过滤规则
22.     Dim filterType(0) As Integer
23.     Dim filterData(0) As Variant
24.     filterType(0) = 0
25.     filterData(0) = "Mtext"
26.    
27.     SSet.SelectOnScreen filterType, filterData
28.    
29.     '创建单行文字***************************************************************
30.     Dim ptMin As Variant, ptMax As Variant
31.     Dim objText As AcadText
32.     Dim objMtext As AcadMText
33.    
34.     Dim i, j As Integer
35.     Dim quantity As Integer            'quantity为Mtext的行数
36.     Dim TextIndex() As Integer         'TextIndex()记录每行所在的位置
37.     Dim tmpStr As String
38.    
39.     Dim ptMin As Variant, ptMax As Variant    '获得多行文字的位置
40.    
41.     For Each objMtext In SSet
42.         '获得文字的主要参数
43.       objMtext.GetBoundingBox ptMin, ptMax
44.         txtStr = objMtext.TextString
45.         height = objMtext.height
46.         '找出Mtext共有几行
47.         quantity = 1
48.         For i = 1 To Len(Mtext)
49.            If Mid(Mtext, i, 1) = "\p" Then quantity = quantity + 1
50.         Next i
51.    
52.         '找出每行行首在Mtext的位置
53.         ReDim TextIndex(quantity)
54.         TextIndex(0) = 0
55.         For j = 1 To quantity
56.             For i = 1 To Len(Mtext)
57.                 If Mid(Mtext, i, 1) = "\p" Then TextIndex(j) = i
58.             Next i
59.         Next j
60.         TextIndex(j) = i
61.         
62.         '将Mtext转换为多行Text文字
63.         For j = 0 To quantity - 1
64.             tmpStr = Mid(txtStr, TextIndex(j) + 1, TextIndex(i + 1) - TextIndex(i) - 1)
65.             ptInsert(0) = ptMin(0)
66.             ptInsert(1) = ptMin(1) + (i + 1) * (ptMax(1) - ptMin(1)) / quantity
67.             ptInsert(2) = ptMin(2)
68.             
69.             Set objText = ThisDrawing.ModelSpace.AddText(tmpStr, ptInsert, height)
70.       
71.         '调整单行文字的对齐方式
72.         objText.InsertionPoint = ptInsert
73.         objMtext.Delete  '删除文字
74.     Next
75.    
76.     SSet.Delete
77. End Sub

Option Explicit Public Sub MtextToText()     On Error Resume Next         Dim ptInsert As Variant     Dim txtStr As String     Dim height As Double     Dim width As Double         '选择多行文字*********************************************     '安全创建选择集     Dim SSet As AcadSelectionSet     If Not IsNull(ThisDrawing.SelectionSets.Item("this")) Then         Set SSet = ThisDrawing.SelectionSets.Item("this")         SSet.Delete     End If     Set SSet = ThisDrawing.SelectionSets.Add("this")         '定义过滤规则     Dim filterType(0) As Integer     Dim filterData(0) As Variant     filterType(0) = 0     filterData(0) = "Mtext"         SSet.SelectOnScreen filterType, filterData         '创建单行文字***************************************************************     Dim ptMin As Variant, ptMax As Variant     Dim objText As AcadText     Dim objMtext As AcadMText         Dim i, j As Integer     Dim quantity As Integer            'quantity为Mtext的行数     Dim TextIndex() As Integer         'TextIndex()记录每行所在的位置     Dim tmpStr As String         Dim ptMin As Variant, ptMax As Variant    '获得多行文字的位置         For Each objMtext In SSet         '获得文字的主要参数       objMtext.GetBoundingBox ptMin, ptMax         txtStr = objMtext.TextString         height = objMtext.height         '找出Mtext共有几行         quantity = 1         For i = 1 To Len(Mtext)            If Mid(Mtext, i, 1) = "\p" Then quantity = quantity + 1         Next i             '找出每行行首在Mtext的位置         ReDim TextIndex(quantity)         TextIndex(0) = 0         For j = 1 To quantity             For i = 1 To Len(Mtext)                 If Mid(Mtext, i, 1) = "\p" Then TextIndex(j) = i             Next i         Next j         TextIndex(j) = i                  '将Mtext转换为多行Text文字         For j = 0 To quantity - 1             tmpStr = Mid(txtStr, TextIndex(j) + 1, TextIndex(i + 1) - TextIndex(i) - 1)             ptInsert(0) = ptMin(0)             ptInsert(1) = ptMin(1) + (i + 1) * (ptMax(1) - ptMin(1)) / quantity             ptInsert(2) = ptMin(2)                          Set objText = ThisDrawing.ModelSpace.AddText(tmpStr, ptInsert, height)                '调整单行文字的对齐方式         objText.InsertionPoint = ptInsert         objMtext.Delete  '删除文字     Next         SSet.Delete End Sub

雪山飞狐_lzh

    Dim ptMin As Variant, ptMax As Variant
    Dim objText As AcadText
    Dim objMtext As AcadMText
   
    Dim i, j As Integer
    Dim quantity As Integer            'quantity为Mtext的行数
    Dim TextIndex() As Integer         'TextIndex()记录每行所在的位置
    Dim tmpStr As String
   
    Dim ptMin As Variant, ptMax As Variant    '获得多行文字的位置

h289990416

这点问题是解决了，谢谢，虽然还是有问题，自己再找找

syk070205

你的创建选择集可能有问题，您可以看考下面的程序！

''''''安全创建选择集
On Error Resume Next
Dim SSet As AcadSelectionSet
If Not IsNull(docObj.SelectionSets.Item("Example")) Then
Set SSet = docObj.SelectionSets.Item("Example")
SSet.Delete   '及时删除不用的选择集非常重要
End If
Set SSet = docObj.SelectionSets.Add("Example")
''''''向选择集中添加实体
SSet.Select acSelectionSetCrossing, ptMin, ptMax
''''''将选择集中的实体添加到数组中
Dim objCollection() As Object
ReDim objCollection(SSet.Count - 1)
Dim i As Integer
For i = 0 To SSet.Count - 1
    Set objCollection(i) = SSet.Item(i)
Next i

luna125

Dim ptMin As Variant, ptMax As Variant
    Dim objText As AcadText
    Dim objMtext As AcadMText
   
    Dim i, j As Integer
    Dim quantity As Integer            'quantity为Mtext的行数
    Dim TextIndex() As Integer         'TextIndex()记录每行所在的位置
    Dim tmpStr As String
   
    Dim ptMin As Variant, ptMax As Variant    '获得多行文字的位置
这个地方重复定义了嘛，
Dim ptMin As Variant, ptMax As Variant
Dim ptMin As Variant, ptMax As Variant    '获得多行文字的位置

chmenf087

提醒一点，Mtext的textstring函数返回值包括格式符号你这样有些Mtext无法转成Text