[在线等待]请问在建立选择集时怎样才能使用平移与缩放命令？

arden

请问在建立选择集时怎样才能使用平移与缩放命令？如下（参考了前面的帖子）
restart:
    On Error Resume Next
    Selset.SelectOnScreen
    '====================================
            If Err Then
               Select Case Err.Number
                    Case -2147467259
                             Err.Clear
                             
                                    
                    Case -2147352567
                                    '按了取消键或其它透明命令
                          varCancel = ThisDrawing.GetVariable ("LASTPROMPT")
                                      If InStr(1, varCancel, "*Cancel*") <> 0 Or InStr(1, varCancel, "*取消*") <> 0 Then
                                        Err.Clear
                                        'Resume Exit_Here
                                        GoTo restart:
                                      Else
                                        Err.Clear
                                        GoTo Exit_Here
                                        'GoTo restart:
                                      End If
               End Select
        End If
但是 Err.Number 的值总是为0,怎样解决？

mccad

这个问题目前无法解决，以前也试图解决过，但最后均没有结果。
关键是在按了平移和缩放时不产生出错，取消后选择的对象无法首先进入选择集。

arden

谢谢mccad,请问还有另外建立选择集的方法吗？我现在必须要建立选择集，但操作时总有一些实体不在窗口上，因此还要用平移和缩放。

efan2000

这是在网上看到的，介绍如何修正这种选择。但我试过之后，还是没有效果。
程序中的注释是我自己添加的，大家可以参考一下。

2. 
   
3. Private Declare Function GetCursor Lib "user32" () As Long
   
4.    
   
5. Public Function SelectOnScreenFix() As AcadSelectionSet
   
6.     Dim objSelSet As AcadSelectionSet
   
7.     Dim objSelCol As AcadSelectionSets
   
8.     Dim intCnt As Integer
   
9.     Dim objEnts() As AcadEntity
   
10.    
    
11.     On Error GoTo Err_Control
    
12.     ' 创建选择集
    
13.     Set objSelCol = ThisDrawing.SelectionSets
    
14.     For Each objSelSet In objSelCol
    
15.         If objSelSet.Name = "sos" Then
    
16.             objSelCol.Item("sos").Delete
    
17.             Exit For
    
18.         End If
    
19.     Next
    
20.     Set objSelSet = objSelCol.Add("sos")
    
21.    
    
22.     ' 当 GetCursor = 0 时，表示正常退出
    
23.     ' 当 GetCursor = 65553 时，表示执行平移、缩放等操作
    
24.     Do
    
25.         objSelSet.SelectOnScreen
    
26.         If GetCursor = 2822 Then ' 这儿有出入，实际测试时为65553
    
27.             ' 这儿也有疑问，执行其它操作时选择集中的实体还没真正产生，因而它的数目为0
    
28.             For intCnt = 0 To ThisDrawing.ActiveSelectionSet.Count - 1
    
29.                 ReDim Preserve objEnts(intCnt)
    
30.                 Set objEnts(intCnt) = ThisDrawing.ActiveSelectionSet(intCnt)
    
31.             Next intCnt
    
32.             objSelSet.AddItems objEnts
    
33.         End If
    
34.     Loop Until GetCursor = 0
    
35.     Set SelectOnScreenFix = objSelSet
    
36.    
    
37. Exit_Here:
    
38.     Exit Function
    
39.    
    
40. Err_Control:
    
41.     Select Case Err.Number
    
42.         Case Else
    
43.             MsgBox Err.Description
    
44.     End Select
    
45. End Function
    

<br /> Private Declare Function GetCursor Lib "user32" () As Long<br />     <br /> Public Function SelectOnScreenFix() As AcadSelectionSet<br />     Dim objSelSet As AcadSelectionSet<br />     Dim objSelCol As AcadSelectionSets<br />     Dim intCnt As Integer<br />     Dim objEnts() As AcadEntity<br />     <br />     On Error GoTo Err_Control<br />     ' 创建选择集<br />     Set objSelCol = ThisDrawing.SelectionSets<br />     For Each objSelSet In objSelCol<br />         If objSelSet.Name = "sos" Then<br />             objSelCol.Item("sos").Delete<br />             Exit For<br />         End If<br />     Next<br />     Set objSelSet = objSelCol.Add("sos")<br />     <br />     ' 当 GetCursor = 0 时，表示正常退出<br />     ' 当 GetCursor = 65553 时，表示执行平移、缩放等操作<br />     Do<br />         objSelSet.SelectOnScreen<br />         If GetCursor = 2822 Then ' 这儿有出入，实际测试时为65553<br />             ' 这儿也有疑问，执行其它操作时选择集中的实体还没真正产生，因而它的数目为0<br />             For intCnt = 0 To ThisDrawing.ActiveSelectionSet.Count - 1<br />                 ReDim Preserve objEnts(intCnt)<br />                 Set objEnts(intCnt) = ThisDrawing.ActiveSelectionSet(intCnt)<br />             Next intCnt<br />             objSelSet.AddItems objEnts<br />         End If<br />     Loop Until GetCursor = 0<br />     Set SelectOnScreenFix = objSelSet<br />     <br /> Exit_Here:<br />     Exit Function<br />     <br /> Err_Control:<br />     Select Case Err.Number<br />         Case Else<br />             MsgBox Err.Description<br />     End Select<br /> End Function<br />

arden

拜托大家帮我解决，我着急用，今晚一直等着。主要是我的图上有300多个闭合多段线，又不能全选，要分别选出，不用平移和缩放怎样办。

HQ_2003

用鼠标中键平移吧

arden

用鼠标中键倒是可以，如果在没有鼠标中键的机子上就麻烦了，且很容易失误。再看有没人能帮忙解决。

mccad

建议：
1.转2004版本；
2.用滚动条平移(呵呵，慢慢点)；
3.如果选择对象是在整个程序的最前面(也就是先选择对象，再执行后面的程序)，可使用LISP的(ssget)来选择对象，然后再执行程序，在需要选择集时用select方法的acSelectionSetPrevious选项来解决。

arden

我没用过2004，里面能有好方法吗？mccad建议的第三种方法到是可以一试，不过我用vba

myfreemind

300多个闭合图形？说说你要做什么？说不定还有别的方法！