社区 › VBA/VB/ActiveX/API 编程技术 › [在线等待]请问在建立选择集时怎样才能使用平移与缩放命令？

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

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


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

arden 发表于 2003-12-21 23:24:00

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

HQ_2003 发表于 2003-12-22 07:53:00

用鼠标中键平移吧

arden 发表于 2003-12-22 16:47:00

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

mccad 发表于 2003-12-22 17:34:00

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

arden 发表于 2003-12-22 22:40:00

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

myfreemind 发表于 2003-12-22 23:10:00

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

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