做了个CAD 输出表格的前置，有个选择集的问题，大神来看下。

jepvyg

这个程序准备用于图纸内的表格输出，本人水平有限，所以前期就是将表格中的多行文字转为单行文字，再将单行文字宽高比改小。最后，将整个表格的高度改为7，文字近似为3.5。这样处理后，再用贱人工具箱的功能，将表格输出。后期有时间再把贱人输出表格的功能加进去。
现在的问题是，现在的选择集不太靠谱：①第三次运行选择集时，在本地窗口中，发现预计框选的数量和sset选择集中的cout数量不一样，差好多，而且同一张表，复制几份，每份运行的结果都不一样（当然也有时，运行的结果是正确的）；②第二次运行选择集时，每次数量都不包括第一次选择集中新建的单行文字的数量。

2. Option Explicit
   
3. 
   
4. Public Sub MTextTotext()
   
5. 
   
6.     On Error Resume Next
   
7. 
   
8.     Dim ptInsert As Variant
   
9. 
   
10.     Dim txtStr As String
    
11. 
    
12.     Dim height As Double
    
13. 
    
14.     Dim width As Double, bbg As Double
    
15. 
    
16.     Dim k As Double, oScale As Double
    
17. 
    
18.     Dim pt1, pt2, pt3   
    
19. 
    
20.     k = 0.4   
    
21. 
    
22.     '确定选择范围区以及表格现有的标高*********************************************
    
23. 
    
24.     pt1 = ThisDrawing.Utility.GetPoint(, "框选左上角一个点: ")
    
25. 
    
26.     pt2 = ThisDrawing.Utility.GetPoint(, "框选右下角一个点: ")
    
27. 
    
28.     pt3 = ThisDrawing.Utility.GetPoint(, "将表格变成7mm高，选取左上角下方邻近点，以确定现有表格高度: ")
    
29. 
    
30.     bbg = GetDistance(pt1, pt3)
    
31. 
    
32.     Dim SSet As AcadSelectionSet
    
33. 
    
34.     oScale = 7 / bbg   
    
35. 
    
36.     '选择多行文字*********************************************
    
37. 
    
38.     '安全创建选择集
    
39. 
    
40.     If Not IsNull(ThisDrawing.SelectionSets.Item("this")) Then
    
41. 
    
42.         Set SSet = ThisDrawing.SelectionSets.Item("this")
    
43. 
    
44.         SSet.Delete
    
45. 
    
46.     End If
    
47. 
    
48.     Set SSet = ThisDrawing.SelectionSets.Add("this")
    
49. 
    
50.     '定义过滤规则
    
51. 
    
52.     Dim filterType(0) As Integer
    
53. 
    
54.     Dim filterData(0) As Variant
    
55. 
    
56.     filterType(0) = 0
    
57. 
    
58.     filterData(0) = "MText"
    
59. 
    
60.     SSet.Select acSelectionSetCrossing, pt1, pt2, filterType, filterData
    
61. 
    
62.     '创建单行文字***************************************************************
    
63. 
    
64.     Dim ptMin As Variant, ptMax As Variant
    
65. 
    
66.     Dim objText As AcadText
    
67. 
    
68.     Dim objMText As AcadMText
    
69. 
    
70.     For Each objMText In SSet
    
71. 
    
72.         '获得文字的主要参数
    
73. 
    
74.         height = objMText.height
    
75. 
    
76.         ptInsert = objMText.InsertionPoint
    
77. 
    
78.         ptInsert(1) = ptInsert(1) - height
    
79. 
    
80.         txtStr = MtextStringClearFormat(objMText.TextString)
    
81. 
    
82.         '文字的限制框宽度
    
83. 
    
84.         Set objText = ThisDrawing.ModelSpace.AddText(txtStr, ptInsert, height)
    
85. 
    
86.         objText.ScaleFactor = k
    
87. 
    
88.         objMText.Delete  '删除原来的多行文字
    
89. 
    
90.     Next
    
91. 
    
92.     SSet.Delete
    
93. 
    
94.      '第二步，在上一步的基础上，实现所有单行文字宽高比，变成K。
    
95. 
    
96.       '安全创建选择集
    
97. 
    
98.     If Not IsNull(ThisDrawing.SelectionSets.Item("this")) Then
    
99. 
    
100.         Set SSet = ThisDrawing.SelectionSets.Item("this")
     
101. 
     
102.         SSet.Delete
     
103. 
     
104.     End If
     
105. 
     
106.     Set SSet = ThisDrawing.SelectionSets.Add("this")
     
107. 
     
108.     '定义过滤规则,选持单行文字。
     
109. 
     
110.     filterType(0) = 0
     
111. 
     
112.     filterData(0) = "Text"
     
113. 
     
114.     SSet.Select acSelectionSetCrossing, pt1, pt2, filterType, filterData
     
115. 
     
116.     For Each objText In SSet
     
117. 
     
118.         objText.ScaleFactor = k
     
119. 
     
120.     Next
     
121. 
     
122.     SSet.Delete   
     
123. 
     
124.     '第三步，表格整体缩放，在现在表格标高的基础上，将单表格高度整体缩放为7mm高，此时文字大概的高度为3.5mm，标准化后以便下一步操作。
     
125. 
     
126.     '安全创建选择集
     
127. 
     
128.     Dim objEnt As AcadEntity
     
129. 
     
130.     If Not IsNull(ThisDrawing.SelectionSets.Item("this")) Then
     
131. 
     
132.         Set SSet = ThisDrawing.SelectionSets.Item("this")
     
133. 
     
134.         SSet.Delete
     
135. 
     
136.     End If
     
137. 
     
138.     Set SSet = ThisDrawing.SelectionSets.Add("this")   
     
139. 
     
140.     SSet.Select acSelectionSetCrossing, pt1, pt2
     
141. 
     
142.     For Each objEnt In SSet
     
143. 
     
144.         objEnt.ScaleEntity pt1, oScale
     
145. 
     
146.     Next           
     
147. 
     
148.     SSet.Delete
     
149. 
     
150. End Sub
     
151. 
     
152. Public Function MtextStringClearFormat(MTextString As String) As String '清除掉多行文字中的格式。
     
153. 
     
154.     Dim MyString As String
     
155. 
     
156.     MyString = MTextString
     
157. 
     
158.     MyString = ReplaceByRegExp(MyString, "\\{", Chr(1))
     
159. 
     
160.     MyString = ReplaceByRegExp(MyString, "\\}", Chr(2))
     
161. 
     
162.     MyString = ReplaceByRegExp(MyString, "\\", Chr(3))
     
163. 
     
164.     MyString = ReplaceByRegExp(MyString, "\\S([^;]*?)(\^|#)([^;]*?);", "$1$3")
     
165. 
     
166.     MyString = ReplaceByRegExp(MyString, "\\S([^;]*?);", "$1")
     
167. 
     
168.     MyString = ReplaceByRegExp(MyString, "(\\P|\\O|\\o|\\L|\\l|\{|\})", "")
     
169. 
     
170.     MyString = ReplaceByRegExp(MyString, "\\[^;]*?;", "")
     
171. 
     
172.     MyString = ReplaceByRegExp(MyString, "\x01", "{")
     
173. 
     
174.     MyString = ReplaceByRegExp(MyString, "\x02", "}")
     
175. 
     
176.     MyString = ReplaceByRegExp(MyString, "\x03", "")
     
177. 
     
178.    MtextStringClearFormat = Trim(MyString)
     
179. 
     
180. End Function
     
181. 
     
182. Public Function ReplaceByRegExp(ByVal Mystrig As String, ByVal TxtFind As String, ByVal TxtReplace As String)
     
183. 
     
184.      Dim RE As Object
     
185. 
     
186.      Set RE = ThisDrawing.Application.GetInterfaceObject("Vbscript.RegExp")   
     
187. 
     
188.     RE.IgnoreCase = False
     
189. 
     
190.      RE.Global = True   
     
191. 
     
192.      RE.Pattern = TxtFind
     
193. 
     
194.     ReplaceByRegExp = RE.Replace(Mystrig, TxtReplace)
     
195. 
     
196.      Set RE = Nothing
     
197. 
     
198. End Function
     
199. 
     
200. '计算两点之间距离
     
201. 
     
202. Public Function GetDistance(sp As Variant, ep As Variant) As Double
     
203. 
     
204.     Dim x As Double
     
205. 
     
206.     Dim y As Double
     
207. 
     
208.     Dim z As Double   
     
209. 
     
210.     x = sp(0) - ep(0)
     
211. 
     
212.     y = sp(1) - ep(1)
     
213. 
     
214.     z = sp(2) - ep(2)   
     
215. 
     
216.     GetDistance = Sqr((Sqr((x ^ 2) + (y ^ 2)) ^ 2) + (z ^ 2))
     
217. 
     
218. End Function

Option Explicit<br /> <br /> Public Sub MTextTotext()<br /> <br />     On Error Resume Next<br /> <br />     Dim ptInsert As Variant<br /> <br />     Dim txtStr As String<br /> <br />     Dim height As Double<br /> <br />     Dim width As Double, bbg As Double<br /> <br />     Dim k As Double, oScale As Double<br /> <br />     Dim pt1, pt2, pt3    <br /> <br />     k = 0.4    <br /> <br />     '确定选择范围区以及表格现有的标高*********************************************<br /> <br />     pt1 = ThisDrawing.Utility.GetPoint(, "框选左上角一个点: ")<br /> <br />     pt2 = ThisDrawing.Utility.GetPoint(, "框选右下角一个点: ")<br /> <br />     pt3 = ThisDrawing.Utility.GetPoint(, "将表格变成7mm高，选取左上角下方邻近点，以确定现有表格高度: ")<br /> <br />     bbg = GetDistance(pt1, pt3)<br /> <br />     Dim SSet As AcadSelectionSet<br /> <br />     oScale = 7 / bbg    <br /> <br />     '选择多行文字*********************************************<br /> <br />     '安全创建选择集<br /> <br />     If Not IsNull(ThisDrawing.SelectionSets.Item("this")) Then<br /> <br />         Set SSet = ThisDrawing.SelectionSets.Item("this")<br /> <br />         SSet.Delete<br /> <br />     End If<br /> <br />     Set SSet = ThisDrawing.SelectionSets.Add("this")<br /> <br />     '定义过滤规则<br /> <br />     Dim filterType(0) As Integer<br /> <br />     Dim filterData(0) As Variant<br /> <br />     filterType(0) = 0<br /> <br />     filterData(0) = "MText"<br /> <br />     SSet.Select acSelectionSetCrossing, pt1, pt2, filterType, filterData<br /> <br />     '创建单行文字***************************************************************<br /> <br />     Dim ptMin As Variant, ptMax As Variant<br /> <br />     Dim objText As AcadText<br /> <br />     Dim objMText As AcadMText<br /> <br />     For Each objMText In SSet<br /> <br />         '获得文字的主要参数<br /> <br />         height = objMText.height<br /> <br />         ptInsert = objMText.InsertionPoint<br /> <br />         ptInsert(1) = ptInsert(1) - height<br /> <br />         txtStr = MtextStringClearFormat(objMText.TextString)<br /> <br />         '文字的限制框宽度<br /> <br />         Set objText = ThisDrawing.ModelSpace.AddText(txtStr, ptInsert, height)<br /> <br />         objText.ScaleFactor = k<br /> <br />         objMText.Delete  '删除原来的多行文字<br /> <br />     Next<br /> <br />     SSet.Delete<br /> <br />      '第二步，在上一步的基础上，实现所有单行文字宽高比，变成K。<br /> <br />       '安全创建选择集<br /> <br />     If Not IsNull(ThisDrawing.SelectionSets.Item("this")) Then<br /> <br />         Set SSet = ThisDrawing.SelectionSets.Item("this")<br /> <br />         SSet.Delete<br /> <br />     End If<br /> <br />     Set SSet = ThisDrawing.SelectionSets.Add("this")<br /> <br />     '定义过滤规则,选持单行文字。<br /> <br />     filterType(0) = 0<br /> <br />     filterData(0) = "Text"<br /> <br />     SSet.Select acSelectionSetCrossing, pt1, pt2, filterType, filterData<br /> <br />     For Each objText In SSet<br /> <br />         objText.ScaleFactor = k<br /> <br />     Next<br /> <br />     SSet.Delete    <br /> <br />     '第三步，表格整体缩放，在现在表格标高的基础上，将单表格高度整体缩放为7mm高，此时文字大概的高度为3.5mm，标准化后以便下一步操作。 <br /> <br />     '安全创建选择集<br /> <br />     Dim objEnt As AcadEntity<br /> <br />     If Not IsNull(ThisDrawing.SelectionSets.Item("this")) Then<br /> <br />         Set SSet = ThisDrawing.SelectionSets.Item("this")<br /> <br />         SSet.Delete<br /> <br />     End If<br /> <br />     Set SSet = ThisDrawing.SelectionSets.Add("this")    <br /> <br />     SSet.Select acSelectionSetCrossing, pt1, pt2<br /> <br />     For Each objEnt In SSet<br /> <br />         objEnt.ScaleEntity pt1, oScale<br /> <br />     Next           <br /> <br />     SSet.Delete<br /> <br /> End Sub<br /> <br /> Public Function MtextStringClearFormat(MTextString As String) As String '清除掉多行文字中的格式。<br /> <br />     Dim MyString As String<br /> <br />     MyString = MTextString<br /> <br />     MyString = ReplaceByRegExp(MyString, "\\{", Chr(1))<br /> <br />     MyString = ReplaceByRegExp(MyString, "\\}", Chr(2))<br /> <br />     MyString = ReplaceByRegExp(MyString, "\\", Chr(3))<br /> <br />     MyString = ReplaceByRegExp(MyString, "\\S([^;]*?)(\^|#)([^;]*?);", "$1$3")<br /> <br />     MyString = ReplaceByRegExp(MyString, "\\S([^;]*?);", "$1")<br /> <br />     MyString = ReplaceByRegExp(MyString, "(\\P|\\O|\\o|\\L|\\l|\{|\})", "")<br /> <br />     MyString = ReplaceByRegExp(MyString, "\\[^;]*?;", "")<br /> <br />     MyString = ReplaceByRegExp(MyString, "\x01", "{")<br /> <br />     MyString = ReplaceByRegExp(MyString, "\x02", "}")<br /> <br />     MyString = ReplaceByRegExp(MyString, "\x03", "")<br /> <br />    MtextStringClearFormat = Trim(MyString)<br /> <br /> End Function<br /> <br /> Public Function ReplaceByRegExp(ByVal Mystrig As String, ByVal TxtFind As String, ByVal TxtReplace As String)<br /> <br />      Dim RE As Object<br /> <br />      Set RE = ThisDrawing.Application.GetInterfaceObject("Vbscript.RegExp")    <br /> <br />     RE.IgnoreCase = False<br /> <br />      RE.Global = True    <br /> <br />      RE.Pattern = TxtFind<br /> <br />     ReplaceByRegExp = RE.Replace(Mystrig, TxtReplace)<br /> <br />      Set RE = Nothing<br /> <br /> End Function<br /> <br /> '计算两点之间距离<br /> <br /> Public Function GetDistance(sp As Variant, ep As Variant) As Double<br /> <br />     Dim x As Double<br /> <br />     Dim y As Double<br /> <br />     Dim z As Double    <br /> <br />     x = sp(0) - ep(0)<br /> <br />     y = sp(1) - ep(1)<br /> <br />     z = sp(2) - ep(2)    <br /> <br />     GetDistance = Sqr((Sqr((x ^ 2) + (y ^ 2)) ^ 2) + (z ^ 2))<br /> <br /> End Function

jepvyg

发现太白了，改进了下，还是那个问题，好像对象多了，就选不中了，不知道，怎么办。

2. Option Explicit
   
3. 
   
4. 
   
5. Public Sub MTextTotext()
   
6.     On Error Resume Next
   
7.    
   
8.     Dim ptInsert As Variant
   
9.     Dim txtStr As String
   
10.     Dim height As Double
    
11.     Dim width As Double, bbg As Double
    
12.     Dim k As Double, oScale As Double
    
13.     Dim pt1, pt2, pt3
    
14.     k = 0.4
    
15.    
    
16. 
    
17.     '确定选择范围区以及表格现有的标高*********************************************
    
18.     pt1 = ThisDrawing.Utility.GetPoint(, "框选左上角一个点: ")
    
19.     pt2 = ThisDrawing.Utility.GetPoint(, "框选右下角一个点: ")
    
20.     pt3 = ThisDrawing.Utility.GetPoint(, "将表格变成7mm高，选取左上角下方邻近点，以确定现有表格高度: ")
    
21.     bbg = GetDistance(pt1, pt3)
    
22.    
    
23.     oScale = 7 / bbg
    
24.     Dim SSet As AcadSelectionSet
    
25.     '选择多行文字*********************************************安全创建选择集
    
26.     If Not IsNull(ThisDrawing.SelectionSets.Item("this")) Then
    
27.         Set SSet = ThisDrawing.SelectionSets.Item("this")
    
28.         SSet.Delete
    
29.     End If
    
30.     Set SSet = ThisDrawing.SelectionSets.Add("this")
    
31.    
    
32. 
    
33. 
    
34.     SSet.Select acSelectionSetCrossing, pt1, pt2   '**********注意了就是这个有问题。也注意过，pt1(2),pt2(2)是0.都在Z平面上。
    
35. 
    
36.     '创建单行文字***************************************************************
    
37.     Dim ptMin As Variant, ptMax As Variant
    
38.     Dim objText As AcadText
    
39.     Dim objMText As AcadMText
    
40.     For Each objMText In SSet
    
41.         '获得文字的主要参数
    
42.         height = objMText.height
    
43.         ptInsert = objMText.InsertionPoint
    
44.         ptInsert(1) = ptInsert(1) - height
    
45.         txtStr = MtextStringClearFormat(objMText.TextString)
    
46.         '文字的限制框宽度
    
47.         Set objText = ThisDrawing.ModelSpace.AddText(txtStr, ptInsert, height)
    
48.         objText.ScaleFactor = k
    
49.         objMText.Delete  '删除原来的多行文字
    
50.     Next
    
51. 
    
52.     For Each objText In SSet
    
53.         '获得文字的主要参数
    
54.         objText.ScaleFactor = k   '单行文字宽度比例改为K
    
55.     Next
    
56. 
    
57.     Dim objEnt As AcadEntity
    
58.     For Each objEnt In SSet     '按比例缩放
    
59.         objEnt.ScaleEntity pt1, oScale
    
60.     Next
    
61.     SSet.Delete
    
62. End Sub
    
63. 
    
64. 
    
65. 
    
66. Public Function MtextStringClearFormat(MTextString As String) As String '清除掉多行文字中的格式。
    
67.     Dim MyString As String
    
68.     MyString = MTextString
    
69.     MyString = ReplaceByRegExp(MyString, "\\{", Chr(1))
    
70.     MyString = ReplaceByRegExp(MyString, "\\}", Chr(2))
    
71.     MyString = ReplaceByRegExp(MyString, "\\\", Chr(3))
    
72.     MyString = ReplaceByRegExp(MyString, "\\S([^;]*?)(\^|#)([^;]*?);", "$1$3")
    
73.     MyString = ReplaceByRegExp(MyString, "\\S([^;]*?);", "$1")
    
74.     MyString = ReplaceByRegExp(MyString, "(\\P|\\O|\\o|\\L|\\l|\{|\})", "")
    
75.     MyString = ReplaceByRegExp(MyString, "\\[^;]*?;", "")
    
76.     MyString = ReplaceByRegExp(MyString, "\x01", "{")
    
77.     MyString = ReplaceByRegExp(MyString, "\x02", "}")
    
78.     MyString = ReplaceByRegExp(MyString, "\x03", "")
    
79.    MtextStringClearFormat = Trim(MyString)
    
80. End Function
    
81. Public Function ReplaceByRegExp(ByVal Mystrig As String, ByVal TxtFind As String, ByVal TxtReplace As String)
    
82.      Dim RE As Object
    
83.      Set RE = ThisDrawing.Application.GetInterfaceObject("Vbscript.RegExp")
    
84.    
    
85.     RE.IgnoreCase = False
    
86.      RE.Global = True
    
87.    
    
88.      RE.Pattern = TxtFind
    
89.     ReplaceByRegExp = RE.Replace(Mystrig, TxtReplace)
    
90.      Set RE = Nothing
    
91. End Function
    
92. 
    
93. 
    
94. '计算两点之间距离
    
95. Public Function GetDistance(sp As Variant, ep As Variant) As Double
    
96.     Dim x As Double
    
97.     Dim y As Double
    
98.     Dim z As Double
    
99.    
    
100.     x = sp(0) - ep(0)
     
101.     y = sp(1) - ep(1)
     
102.     z = sp(2) - ep(2)
     
103.    
     
104.     GetDistance = Sqr((Sqr((x ^ 2) + (y ^ 2)) ^ 2) + (z ^ 2))
     
105. End Function
     

Option Explicit<br /> <br /> <br /> Public Sub MTextTotext()<br />     On Error Resume Next<br />     <br />     Dim ptInsert As Variant<br />     Dim txtStr As String<br />     Dim height As Double<br />     Dim width As Double, bbg As Double<br />     Dim k As Double, oScale As Double<br />     Dim pt1, pt2, pt3<br />     k = 0.4<br />     <br /> <br />     '确定选择范围区以及表格现有的标高*********************************************<br />     pt1 = ThisDrawing.Utility.GetPoint(, "框选左上角一个点: ")<br />     pt2 = ThisDrawing.Utility.GetPoint(, "框选右下角一个点: ")<br />     pt3 = ThisDrawing.Utility.GetPoint(, "将表格变成7mm高，选取左上角下方邻近点，以确定现有表格高度: ")<br />     bbg = GetDistance(pt1, pt3)<br />     <br />     oScale = 7 / bbg<br />     Dim SSet As AcadSelectionSet<br />     '选择多行文字*********************************************安全创建选择集<br />     If Not IsNull(ThisDrawing.SelectionSets.Item("this")) Then<br />         Set SSet = ThisDrawing.SelectionSets.Item("this")<br />         SSet.Delete<br />     End If<br />     Set SSet = ThisDrawing.SelectionSets.Add("this")<br />     <br /> <br /> <br />     SSet.Select acSelectionSetCrossing, pt1, pt2   '**********注意了就是这个有问题。也注意过，pt1(2),pt2(2)是0.都在Z平面上。<br /> <br />     '创建单行文字***************************************************************<br />     Dim ptMin As Variant, ptMax As Variant<br />     Dim objText As AcadText<br />     Dim objMText As AcadMText<br />     For Each objMText In SSet<br />         '获得文字的主要参数<br />         height = objMText.height<br />         ptInsert = objMText.InsertionPoint<br />         ptInsert(1) = ptInsert(1) - height<br />         txtStr = MtextStringClearFormat(objMText.TextString)<br />         '文字的限制框宽度<br />         Set objText = ThisDrawing.ModelSpace.AddText(txtStr, ptInsert, height)<br />         objText.ScaleFactor = k<br />         objMText.Delete  '删除原来的多行文字<br />     Next<br /> <br />     For Each objText In SSet<br />         '获得文字的主要参数<br />         objText.ScaleFactor = k   '单行文字宽度比例改为K<br />     Next<br /> <br />     Dim objEnt As AcadEntity<br />     For Each objEnt In SSet     '按比例缩放<br />         objEnt.ScaleEntity pt1, oScale<br />     Next<br />     SSet.Delete<br /> End Sub<br /> <br /> <br /> <br /> Public Function MtextStringClearFormat(MTextString As String) As String '清除掉多行文字中的格式。<br />     Dim MyString As String<br />     MyString = MTextString<br />     MyString = ReplaceByRegExp(MyString, "\\{", Chr(1))<br />     MyString = ReplaceByRegExp(MyString, "\\}", Chr(2))<br />     MyString = ReplaceByRegExp(MyString, "\\\", Chr(3))<br />     MyString = ReplaceByRegExp(MyString, "\\S([^;]*?)(\^|#)([^;]*?);", "$1$3")<br />     MyString = ReplaceByRegExp(MyString, "\\S([^;]*?);", "$1")<br />     MyString = ReplaceByRegExp(MyString, "(\\P|\\O|\\o|\\L|\\l|\{|\})", "")<br />     MyString = ReplaceByRegExp(MyString, "\\[^;]*?;", "")<br />     MyString = ReplaceByRegExp(MyString, "\x01", "{")<br />     MyString = ReplaceByRegExp(MyString, "\x02", "}")<br />     MyString = ReplaceByRegExp(MyString, "\x03", "")<br />    MtextStringClearFormat = Trim(MyString)<br /> End Function<br /> Public Function ReplaceByRegExp(ByVal Mystrig As String, ByVal TxtFind As String, ByVal TxtReplace As String)<br />      Dim RE As Object<br />      Set RE = ThisDrawing.Application.GetInterfaceObject("Vbscript.RegExp")<br />     <br />     RE.IgnoreCase = False<br />      RE.Global = True<br />     <br />      RE.Pattern = TxtFind<br />     ReplaceByRegExp = RE.Replace(Mystrig, TxtReplace)<br />      Set RE = Nothing<br /> End Function<br /> <br /> <br /> '计算两点之间距离<br /> Public Function GetDistance(sp As Variant, ep As Variant) As Double<br />     Dim x As Double<br />     Dim y As Double<br />     Dim z As Double<br />     <br />     x = sp(0) - ep(0)<br />     y = sp(1) - ep(1)<br />     z = sp(2) - ep(2)<br />     <br />     GetDistance = Sqr((Sqr((x ^ 2) + (y ^ 2)) ^ 2) + (z ^ 2))<br /> End Function<br />

jepvyg

http://bbs.mjtd.com/forum.php?mo ... =%D1%A1%D4%F1%BC%AF
想不到自己找到原因了。
感谢

http://www.mjtd.com/home.php?mod=space&uid=63914

664571221

jepvyg 发表于 2022-1-4 13:58
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=175903&highlight=%D1%A1%D4%F1%BC%AF
想不到自己找到 ...

厉害楼主牛逼class