哪位帮我看看，该如何优化，谢谢了

szj612 发表于 2013-9-20 16:33:07

本帖最后由 szj612 于 2013-9-20 16:33 编辑

以下是我写的用于统计圆的程式，把相同规格的圆分别统计
只能统计5种规格的直径和5种规格的color,现在我想改为更多规格，能不能用循环解决？能不能不限规格？
谢谢！

Public Sub TEST() '测试用

Dim sset As AcadSelectionSet
Set sset = ThisDrawing.SelectionSets.Add("dsdgds")
sset.SelectOnScreen
Dim Ent As AcadEntity
Dim A As Long
Dim I(1, 5) As Long '5种不同的直径，其余都归于第6种,计数和记录值各用一维
Dim J(1, 5, 5) As Long '对应不同直径的5种不同的COLOR，其余都归于第6种,计数和记录值各用一维
For Each Ent In sset
2:
Select Case CLng(Ent.Diameter)
Case I(0, 0)
I(1, 0) = I(1, 0) + 1
Select Case Ent.color
Case J(0, 0, 0)
   J(1, 0, 0) = J(1, 0, 0) + 1
Case J(0, 0, 1)
   J(1, 0, 1) = J(1, 0, 1) + 1
Case J(0, 0, 2)
   J(1, 0, 2) = J(1, 0, 2) + 1
Case J(0, 0, 3)
   J(1, 0, 3) = J(1, 0, 3) + 1
Case J(0, 0, 4)
   J(1, 0, 4) = J(1, 0, 4) + 1
Case Else
   If J(0, 0, 0) = 0 Then
         J(0, 0, 0) = Ent.color
         GoTo 2:
   ElseIf J(0, 0, 1) = 0 Then
         J(0, 0, 1) = Ent.color
         GoTo 2
   ElseIf J(0, 0, 2) = 0 Then
         J(0, 0, 2) = Ent.color
         GoTo 2
   ElseIf J(0, 0, 3) = 0 Then
         J(0, 0, 3) = Ent.color
         GoTo 2
   ElseIf J(0, 0, 4) = 0 Then
         J(0, 0, 4) = Ent.color
         GoTo 2
   Else
         J(1, 0, 5) = J(1, 0, 5) + 1
   End If
End Select
Case I(0, 1)
I(1, 1) = I(1, 1) + 1
Select Case Ent.color
Case J(0, 1, 0)
   J(1, 1, 0) = J(1, 1, 0) + 1
Case J(0, 1, 1)
   J(1, 1, 1) = J(1, 1, 1) + 1
Case J(0, 1, 2)
   J(1, 1, 2) = J(1, 1, 2) + 1
Case J(0, 1, 3)
   J(1, 1, 3) = J(1, 1, 3) + 1
Case J(0, 1, 4)
   J(1, 1, 4) = J(1, 1, 4) + 1
Case Else
   If J(0, 1, 0) = 0 Then
         J(0, 1, 0) = Ent.color
         GoTo 2:
   ElseIf J(0, 1, 1) = 0 Then
         J(0, 1, 1) = Ent.color
         GoTo 2
   ElseIf J(0, 1, 2) = 0 Then
         J(0, 1, 2) = Ent.color
         GoTo 2
   ElseIf J(0, 1, 3) = 0 Then
         J(0, 1, 3) = Ent.color
         GoTo 2
   ElseIf J(0, 1, 4) = 0 Then
         J(0, 1, 4) = Ent.color
         GoTo 2
   Else
         J(1, 1, 5) = J(1, 1, 5) + 1
   End If
End Select
Case I(0, 2)
I(1, 2) = I(1, 2) + 1
Select Case Ent.color
Case J(0, 2, 0)
   J(1, 2, 0) = J(1, 2, 0) + 1
Case J(0, 2, 1)
   J(1, 0, 1) = J(1, 2, 1) + 1
Case J(0, 2, 2)
   J(1, 2, 2) = J(1, 2, 2) + 1
Case J(0, 2, 3)
   J(1, 2, 3) = J(1, 2, 3) + 1
Case J(0, 2, 4)
   J(1, 2, 4) = J(1, 2, 4) + 1
Case Else
   If J(0, 2, 0) = 0 Then
         J(0, 2, 0) = Ent.color
         GoTo 2:
   ElseIf J(0, 2, 1) = 0 Then
         J(0, 2, 1) = Ent.color
         GoTo 2
   ElseIf J(0, 2, 2) = 0 Then
         J(0, 2, 2) = Ent.color
         GoTo 2
   ElseIf J(0, 2, 3) = 0 Then
         J(0, 2, 3) = Ent.color
         GoTo 2
   ElseIf J(0, 2, 4) = 0 Then
         J(0, 2, 4) = Ent.color
         GoTo 2
   Else
         J(1, 2, 5) = J(1, 2, 5) + 1
   End If
End Select
Case I(0, 3)
I(1, 3) = I(1, 3) + 1
Select Case Ent.color
Case J(0, 3, 0)
   J(1, 3, 0) = J(1, 3, 0) + 1
Case J(0, 3, 1)
   J(1, 3, 1) = J(1, 3, 1) + 1
Case J(0, 3, 2)
   J(1, 3, 2) = J(1, 3, 2) + 1
Case J(0, 3, 3)
   J(1, 3, 3) = J(1, 3, 3) + 1
Case J(0, 3, 4)
   J(1, 3, 4) = J(1, 3, 4) + 1
Case Else
   If J(0, 3, 0) = 0 Then
         J(0, 3, 0) = Ent.color
         GoTo 2:
   ElseIf J(0, 3, 1) = 0 Then
         J(0, 3, 1) = Ent.color
         GoTo 2
   ElseIf J(0, 3, 2) = 0 Then
         J(0, 3, 2) = Ent.color
         GoTo 2
   ElseIf J(0, 3, 3) = 0 Then
         J(0, 3, 3) = Ent.color
         GoTo 2
   ElseIf J(0, 3, 4) = 0 Then
         J(0, 3, 4) = Ent.color
         GoTo 2
   Else
         J(1, 3, 5) = J(1, 3, 5) + 1
   End If
End Select
Case I(0, 4)
I(1, 4) = I(1, 4) + 1
Select Case Ent.color
Case J(0, 4, 0)
   J(1, 4, 0) = J(1, 4, 0) + 1
Case J(0, 4, 1)
   J(1, 4, 1) = J(1, 4, 1) + 1
Case J(0, 4, 2)
   J(1, 4, 2) = J(1, 4, 2) + 1
Case J(0, 4, 3)
   J(1, 4, 3) = J(1, 4, 3) + 1
Case J(0, 4, 4)
   J(1, 4, 4) = J(1, 4, 4) + 1
Case Else
   If J(0, 4, 0) = 0 Then
         J(0, 4, 0) = Ent.color
         GoTo 2:
   ElseIf J(0, 4, 1) = 0 Then
         J(0, 4, 1) = Ent.color
         GoTo 2
   ElseIf J(0, 4, 2) = 0 Then
         J(0, 4, 2) = Ent.color
         GoTo 2
   ElseIf J(0, 4, 3) = 0 Then
         J(0, 4, 3) = Ent.color
         GoTo 2
   ElseIf J(0, 4, 4) = 0 Then
         J(0, 4, 4) = Ent.color
         GoTo 2
   Else
         J(1, 4, 5) = J(1, 4, 5) + 1
   End If
End Select
Case Else
If I(0, 0) = 0 Then
   I(0, 0) = CLng(Ent.Diameter)
   GoTo 2
ElseIf I(0, 1) = 0 Then
   I(0, 1) = CLng(Ent.Diameter)
   GoTo 2
ElseIf I(0, 2) = 0 Then
   I(0, 2) = CLng(Ent.Diameter)
   GoTo 2
ElseIf I(0, 3) = 0 Then
   I(0, 3) = CLng(Ent.Diameter)
   GoTo 2
ElseIf I(0, 4) = 0 Then
   I(0, 4) = CLng(Ent.Diameter)
   GoTo 2
Else
   I(1, 5) = I(1, 5) + 1
End If
End Select
Next
Dim op As Variant                      '输出结果
op = ThisDrawing.Utility.GetPoint
Dim txt As AcadText
For M = 0 To 5
For N = 0 To 5
   If J(1, M, N) > 0 Then
         Set txt = ThisDrawing.ModelSpace.AddText(J(1, M, N) & "-" & I(0, M) & "*" & J(0, M, N), op, 4)
         op(1) = op(1) - 6
   End If
Next N
Next M
sset.Delete
End Sub

wwswwswws 发表于 2013-9-20 23:59:19

把圆的直径、颜色和ID写入数据库，然后用SQL语言建立一个查询完全可以不用这么麻烦而达到你的要求。

szj612 发表于 2013-9-21 10:22:08

谢谢楼上，因为编程只是业余爱好，所以还不懂怎么操作数据库，我想知道，如果不用数据库，有没有好的算法？不限规格有困难的话，可以限定规格，实际上规格（直径）和子规格（颜色）不会超过15。
这个程式所要解决的现实示例是：在一张总图中，包含许多个螺丝，因为螺丝是标准件，所以大小规格（直径）不是很多，但同一大小又可能存在多种长度（程式中以颜色代替），我想列出清单，把相同规格的螺丝汇总。

mccad 发表于 2013-9-21 21:06:52

找找排序的函数，然后建立数组，将圆的直径、颜色、句柄等信息组合成多维数组。
通过数组中的某一维元素进行排序，排序后你就知道怎么处理了。
排序过程设成独立的函数，这样你想处理多少数据都可以。

szj612 发表于 2013-9-22 00:29:00

谢谢明总，我明白了思路，估计在原理上和数据库也差不多，我试试看。

页: [1]

明经CAD社区's Archiver

哪位帮我看看，该如何优化，谢谢了