[VBA程序]：请帮我看一下这段程序

gjliang

大家好，最近写了个小程序，在使用过程中出现了一些问题，期望得到大家的帮助，下面是程序。

2. 
   
3.   [FONT=courier new]
   
4. Sub lc()
   
5. Dim ss As AcadSelectionSet
   
6. Set ss = GetSelSet
   
7. Dim ent As AcadEntity
   
8. Dim lc As Double
   
9. Dim SF As Double
   
10. Dim tx As String
    
11. Dim sa As Boolean
    
12. Dim i As Integer
    
13. i = 0
    
14. sa = False
    
15. Dim Obj As AcadEntity
    
16. For Each ent In ss
    
17.      If TypeOf ent Is AcadEntity Then
    
18.         i = i + 1
    
19.         Set Obj = ent
    
20.         If sa = False Then
    
21.            SF = Obj.LinetypeScale
    
22.              On Error GoTo errtap
    
23.              lc = ThisDrawing.Utility.GetReal("输入新的线型比例<" & SF & ">:")
    
24.                If i = 1 Then
    
25.                  ThisDrawing.Utility.InitializeUserInput 0, "Y N"
    
26.                    If Err Or tx = "" Then
    
27.                      tx = "Y"
    
28.                      End If
    
29.                     If tx = "Y" Then
    
30.                     sa = True
    
31.                 End If
    
32.             End If
    
33.          End If
    
34.         ent.LinetypeScale = lc
    
35.        End If
    
36.     Next
    
37. errtap: Exit Sub
    
38. End Sub
    
39. 
    
40. Function GetSelSet() As AcadSelectionSet
    
41.     Dim ss As AcadSelectionSet
    
42.     Set ss = ThisDrawing.PickfirstSelectionSet
    
43.     On Error Resume Next
    
44.     If ss.Count = 0 Then
    
45.         Dim ssName As String
    
46.         ssName = "strSSet"
    
47.         On Error Resume Next
    
48.         Set ss = ThisDrawing.SelectionSets(ssName)
    
49.         If Err Then Set ss = ThisDrawing.SelectionSets.add(ssName)
    
50.         ss.Clear
    
51.         ss.SelectOnScreen
    
52.     End If
    
53.     Set GetSelSet = ss
    
54.     ThisDrawing.SetVariable "filedia", 1
    
55. End Function
    
56. 
    
57.   [/FONT]
    

<br />   [FONT=courier new]<br /> Sub lc()<br /> Dim ss As AcadSelectionSet<br /> Set ss = GetSelSet<br /> Dim ent As AcadEntity<br /> Dim lc As Double<br /> Dim SF As Double<br /> Dim tx As String<br /> Dim sa As Boolean<br /> Dim i As Integer<br /> i = 0<br /> sa = False<br /> Dim Obj As AcadEntity<br /> For Each ent In ss<br />      If TypeOf ent Is AcadEntity Then<br />         i = i + 1<br />         Set Obj = ent<br />         If sa = False Then<br />            SF = Obj.LinetypeScale<br />              On Error GoTo errtap<br />              lc = ThisDrawing.Utility.GetReal("输入新的线型比例<" & SF & ">:")<br />                If i = 1 Then<br />                  ThisDrawing.Utility.InitializeUserInput 0, "Y N"<br />                    If Err Or tx = "" Then<br />                      tx = "Y"<br />                      End If<br />                     If tx = "Y" Then<br />                     sa = True<br />                 End If<br />             End If<br />          End If<br />         ent.LinetypeScale = lc<br />        End If<br />     Next<br /> errtap: Exit Sub<br /> End Sub<br /> <br /> Function GetSelSet() As AcadSelectionSet<br />     Dim ss As AcadSelectionSet<br />     Set ss = ThisDrawing.PickfirstSelectionSet<br />     On Error Resume Next<br />     If ss.Count = 0 Then<br />         Dim ssName As String<br />         ssName = "strSSet"<br />         On Error Resume Next<br />         Set ss = ThisDrawing.SelectionSets(ssName)<br />         If Err Then Set ss = ThisDrawing.SelectionSets.add(ssName)<br />         ss.Clear<br />         ss.SelectOnScreen<br />     End If<br />     Set GetSelSet = ss<br />     ThisDrawing.SetVariable "filedia", 1<br /> End Function<br /> <br />   [/FONT]<br />

问题如下：1.在使用过程中会自动修改filedia的变量植为“0”
          2.在使用一定时间后程序就不在起作用，这是最烦人的地方
          3.目前只能是先执行程序在选择对象，请问怎样做到先选择后执行程序

efan2000

1、If TypeOf ent Is AcadEntity Then[/COLOR]，在选择集中的实体肯定是AcadEntity类型的，那么If TypeOf ent Is AcadEntity Then这一句就是多余的。
2、Dim lc As Double[/COLOR]，过程名称已经使用了lc，那么过程内部的局部变量lc就不能再声明和使用了。
3、ThisDrawing.Utility.InitializeUserInput 0, "Y N"[/COLOR]，既然用户需要输入的仅仅是实数，那么这一句就没必要。
4、lc = ThisDrawing.Utility.GetReal("输入新的线型比例<" & SF & ">:")[/COLOR]，当用户选择的实体是多个时，并且各个实体的线型比例可能不完全相同时，那么这个默认的值以哪个为准。

Laoyao

GetSelSet() 中两句
On Error Resume Next
重复

1.在使用过程中会自动修改filedia的变量植为“0”
你是否有其它的程序对filedia有赋值

gjliang

多谢efan斑竹的指点，你的第二个观点是不是引起程序运行几次在运行就产生不了效果的原因等我明天到办公室调试一下在看看吧，因为当时这样写也是图方便，在执行过程中并没有报出过程名和变量名同名的错误。第三条原来我已经注释掉了，第四个是我没想到的，因为当选择了多个不一样线型比例的实体时它会返回第一个被框选的实体的线型比例值。
其实这个程序也只是写来玩的，在使用过程中没想到会有那么多问题，filedia变量值的自动修改是不知道怎么回事了，因为使用时只调用了这一个程序。

efan2000

过程名称和变量名称相同的时候，主要是用于递归算法当中，如阶乘。
程序对filedia应该没有影响，我在R2000下运行并没有变更它的值。
先选择后执行程序可以用PickfirstSelectionSet获取，但是它经常会出现自动清除掉已经选择的实体，特别是在过程当中先执行其它代码时，更好的是通过AcadDocument对象的BeginShortcutMenuEdit事件来操作，但是它只用于右键菜单中。

gjliang

今天找到了程序运行中失效的一个问题，就是在一个文档中操作时，如果此时执行open命令，并取消打开文档，然后在运行本程序就会产生只选择而无法执行更改线形比例的程序代码。