数字按规律求和

zhengchuan

xyp1964 发表于 2012-9-23 09:45

差不多吧。反正尽量三相平衡啦。搞电力都明白啦

zml84

源码参考：http://zml84.blog.sohu.com/239224434.html

sscylh

用vba行吗?楼主您的问题解决了吗已经?

sscylh

用vba写的,在我电脑上测试无误:

2. Sub aa()
   
3. Dim arr()
   
4. Dim xls As Excel.Application
   
5. Set xls = New Excel.Application
   
6. Dim s As AcadText
   
7. Dim str As String
   
8. Dim returnPnt As Variant
   
9. Dim ss As AcadSelectionSet
   
10. Set ss = ThisDrawing.SelectionSets.Add(Rnd() & "ffdfd")
    
11. Dim gpCode(0) As Integer
    
12. Dim dataValue(0) As Variant
    
13. gpCode(0) = 0
    
14. dataValue(0) = "text"
    
15. ss.SelectOnScreen gpCode, dataValue
    
16. s1 = UCase(InputBox("赋最大值给:"))
    
17. s2 = UCase(InputBox("赋第二大值给:"))
    
18. s3 = UCase(InputBox("赋第三大值给:"))
    
19. For i = 1 To ss.Count
    
20. Set s = ss(i - 1)
    
21. If IsNumeric(s.TextString) Then
    
22. cnt = cnt + 1
    
23. ReDim Preserve arr(1 To cnt)
    
24. arr(i) = --s.TextString
    
25. End If
    
26. Next
    
27. max1 = xls.Large(arr, 1) + xls.Large(arr, 6)
    
28. max2 = xls.Large(arr, 2) + xls.Large(arr, 5)
    
29. max3 = xls.Large(arr, 3) + xls.Large(arr, 4)
    
30. brr = Array(max1, max2, max3)
    
31. On Error Resume Next
    
32. For i = 7 To UBound(arr) Step 3
    
33. imax1 = 0
    
34. imax2 = 0
    
35. imax3 = 0
    
36.   For j = 1 To 3
    
37.     If brr(j - 1) >= max3 Then imax3 = imax3 + 1
    
38.     If brr(j - 1) >= max2 Then imax2 = imax2 + 1
    
39.     If brr(j - 1) >= max1 Then imax1 = imax1 + 1
    
40.   Next
    
41. max3 = max3 + xls.Large(arr, 3 - imax3 + i)
    
42. max2 = max2 + xls.Large(arr, (3 - imax2) + i)
    
43. max1 = max1 + xls.Large(arr, 3 - imax1 + i)
    
44. brr = Array(max1, max2, max3)
    
45. Next
    
46. str = s1 & ":" & max1 & Chr(10) & s2 & ":" & max2 & Chr(10) & s3 & ":" & max3
    
47. returnPnt = ThisDrawing.Utility.GetPoint(, "请点击获取插入点")
    
48. ThisDrawing.ModelSpace.AddMText returnPnt, 10, str
    
49. End Sub

Sub aa()<br /> Dim arr()<br /> Dim xls As Excel.Application<br /> Set xls = New Excel.Application<br /> Dim s As AcadText<br /> Dim str As String<br /> Dim returnPnt As Variant<br /> Dim ss As AcadSelectionSet<br /> Set ss = ThisDrawing.SelectionSets.Add(Rnd() & "ffdfd")<br /> Dim gpCode(0) As Integer<br /> Dim dataValue(0) As Variant<br /> gpCode(0) = 0<br /> dataValue(0) = "text"<br /> ss.SelectOnScreen gpCode, dataValue<br /> s1 = UCase(InputBox("赋最大值给:"))<br /> s2 = UCase(InputBox("赋第二大值给:"))<br /> s3 = UCase(InputBox("赋第三大值给:"))<br /> For i = 1 To ss.Count<br /> Set s = ss(i - 1)<br /> If IsNumeric(s.TextString) Then<br /> cnt = cnt + 1<br /> ReDim Preserve arr(1 To cnt)<br /> arr(i) = --s.TextString<br /> End If<br /> Next<br /> max1 = xls.Large(arr, 1) + xls.Large(arr, 6)<br /> max2 = xls.Large(arr, 2) + xls.Large(arr, 5)<br /> max3 = xls.Large(arr, 3) + xls.Large(arr, 4)<br /> brr = Array(max1, max2, max3)<br /> On Error Resume Next<br /> For i = 7 To UBound(arr) Step 3<br /> imax1 = 0<br /> imax2 = 0<br /> imax3 = 0<br />   For j = 1 To 3<br />     If brr(j - 1) >= max3 Then imax3 = imax3 + 1<br />     If brr(j - 1) >= max2 Then imax2 = imax2 + 1<br />     If brr(j - 1) >= max1 Then imax1 = imax1 + 1<br />   Next<br /> max3 = max3 + xls.Large(arr, 3 - imax3 + i)<br /> max2 = max2 + xls.Large(arr, (3 - imax2) + i)<br /> max1 = max1 + xls.Large(arr, 3 - imax1 + i)<br /> brr = Array(max1, max2, max3)<br /> Next<br /> str = s1 & ":" & max1 & Chr(10) & s2 & ":" & max2 & Chr(10) & s3 & ":" & max3<br /> returnPnt = ThisDrawing.Utility.GetPoint(, "请点击获取插入点")<br /> ThisDrawing.ModelSpace.AddMText returnPnt, 10, str<br /> End Sub

sscylh

传上附件!     

sscylh

zml84 发表于 2012-9-24 13:17
源码参考：http://zml84.blog.sohu.com/239224434.html

如附件动画所示:

sscylh

33楼代码有点小问题,现传上新代码:

2. Sub aa()
   
3. Dim arr()
   
4. Dim xls As Excel.Application
   
5. Set xls = New Excel.Application
   
6. Dim s As AcadText
   
7. Dim str As String
   
8. Dim returnPnt As Variant
   
9. Dim mt As AcadMText
   
10. Dim ss As AcadSelectionSet
    
11. Set ss = ThisDrawing.SelectionSets.Add(Rnd() & "ffdfdfd")
    
12. Dim gpCode(0) As Integer
    
13. Dim dataValue(0) As Variant
    
14. gpCode(0) = 0
    
15. dataValue(0) = "text"
    
16. ss.SelectOnScreen gpCode, dataValue
    
17. s1 = UCase(InputBox("赋最大值给:"))
    
18. s2 = UCase(InputBox("赋第二大值给:"))
    
19. s3 = UCase(InputBox("赋第三大值给:"))
    
20. For i = 1 To ss.Count
    
21. Set s = ss(i - 1)
    
22. If IsNumeric(s.TextString) Then
    
23. cnt = cnt + 1
    
24. ReDim Preserve arr(1 To cnt)
    
25. arr(cnt) = --s.TextString
    
26. End If
    
27. Next
    
28. max1 = xls.Large(arr, 1) + xls.Large(arr, 6)
    
29. max2 = xls.Large(arr, 2) + xls.Large(arr, 5)
    
30. max3 = xls.Large(arr, 3) + xls.Large(arr, 4)
    
31. brr = Array(max1, max2, max3)
    
32. On Error Resume Next
    
33. For i = 7 To UBound(arr) Step 3
    
34. imax1 = 0
    
35. imax2 = 0
    
36. imax3 = 0
    
37.   For j = 1 To 3
    
38.     If brr(j - 1) >= max3 Then imax3 = imax3 + 1
    
39.     If brr(j - 1) >= max2 Then imax2 = imax2 + 1
    
40.     If brr(j - 1) >= max1 Then imax1 = imax1 + 1
    
41.   Next
    
42. max3 = max3 + xls.Large(arr, 3 - imax3 + i)
    
43. max2 = max2 + xls.Large(arr, (3 - imax2) + i)
    
44. max1 = max1 + xls.Large(arr, 3 - imax1 + i)
    
45. brr = Array(max1, max2, max3)
    
46. Next
    
47. str = s1 & "的和:" & max1 & Chr(10) & s2 & "的和:" & max2 & Chr(10) & s3 & "的和:" & max3
    
48. returnPnt = ThisDrawing.Utility.GetPoint(, "请点击获取插入点")
    
49. Set mt = ThisDrawing.ModelSpace.AddMText(returnPnt, 5000, str)
    
50. mt.Height = 300
    
51. 
    
52. 
    
53. 
    
54. End Sub
    

Sub aa()<br /> Dim arr()<br /> Dim xls As Excel.Application<br /> Set xls = New Excel.Application<br /> Dim s As AcadText<br /> Dim str As String<br /> Dim returnPnt As Variant<br /> Dim mt As AcadMText<br /> Dim ss As AcadSelectionSet<br /> Set ss = ThisDrawing.SelectionSets.Add(Rnd() & "ffdfdfd")<br /> Dim gpCode(0) As Integer<br /> Dim dataValue(0) As Variant<br /> gpCode(0) = 0<br /> dataValue(0) = "text"<br /> ss.SelectOnScreen gpCode, dataValue<br /> s1 = UCase(InputBox("赋最大值给:"))<br /> s2 = UCase(InputBox("赋第二大值给:"))<br /> s3 = UCase(InputBox("赋第三大值给:"))<br /> For i = 1 To ss.Count<br /> Set s = ss(i - 1)<br /> If IsNumeric(s.TextString) Then<br /> cnt = cnt + 1<br /> ReDim Preserve arr(1 To cnt)<br /> arr(cnt) = --s.TextString<br /> End If<br /> Next<br /> max1 = xls.Large(arr, 1) + xls.Large(arr, 6)<br /> max2 = xls.Large(arr, 2) + xls.Large(arr, 5)<br /> max3 = xls.Large(arr, 3) + xls.Large(arr, 4)<br /> brr = Array(max1, max2, max3)<br /> On Error Resume Next<br /> For i = 7 To UBound(arr) Step 3<br /> imax1 = 0<br /> imax2 = 0<br /> imax3 = 0<br />   For j = 1 To 3<br />     If brr(j - 1) >= max3 Then imax3 = imax3 + 1<br />     If brr(j - 1) >= max2 Then imax2 = imax2 + 1<br />     If brr(j - 1) >= max1 Then imax1 = imax1 + 1<br />   Next<br /> max3 = max3 + xls.Large(arr, 3 - imax3 + i)<br /> max2 = max2 + xls.Large(arr, (3 - imax2) + i)<br /> max1 = max1 + xls.Large(arr, 3 - imax1 + i)<br /> brr = Array(max1, max2, max3)<br /> Next<br /> str = s1 & "的和:" & max1 & Chr(10) & s2 & "的和:" & max2 & Chr(10) & s3 & "的和:" & max3<br /> returnPnt = ThisDrawing.Utility.GetPoint(, "请点击获取插入点")<br /> Set mt = ThisDrawing.ModelSpace.AddMText(returnPnt, 5000, str)<br /> mt.Height = 300<br /> <br /> <br /> <br /> End Sub<br />

sscylh

下面是附件:

sscylh

vba要正常运行,要先在vbe编辑器中引用:
工具----引用----microsoft excel object libiray

不知道合不合楼主意,花了我一个中午午休的时间,如果可以的话,楼主的100大洋.......

zhengchuan

不好意思。这几天在赶份图纸。白天单位上不了网，回家都很晚啦。zml84 兄和sscylh 兄大作都看啦。zml84 兄的程序加载显示输入的列表有缺陷。sscylh兄的满足了一个要求。其实我还需要的是在相别上要标上ABC。光有这ABC的和没用啊。
程序达到目的即可，用哪种语言都无所谓啦。
望二位费费心再给完善下拉。