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

arden · 发表于 2003-12-21 22:46:00

请问在建立选择集时怎样才能使用平移与缩放命令？如下（参考了前面的帖子）
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 · 发表于 2003-12-21 22:51:00

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

arden · 发表于 2003-12-21 23:07:00

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

efan2000 · 发表于 2003-12-21 23:14:00

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

copy


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