Author Topic: Entsel version  (Read 3261 times)

0 Members and 1 Guest are viewing this topic.

Bryco

  • Water Moccasin
  • Posts: 1882
Entsel version
« on: March 28, 2006, 08:42:50 PM »
Hoping to get this version in to functions as the addition of "Optional vPoint As Variant" is extremely handy


Public Const VK_ESCAPE = &H1B
Public Const VK_LBUTTON = &H1
Public Const VK_SPACE = &H20
Public Const VK_RETURN = &HD
Public Const VK_LEFT = &H25

Public Declare Function GetAsyncKeyState Lib "user32" _
        (ByVal vKey As Long) As Integer



'Randall single selection
Public Function EntSel(Optional strPrmt As String = "Select an entity: ", Optional vPoint As Variant) As AcadEntity
    Dim objTemp As AcadEntity
    Dim objUtil As AcadUtility
    Dim varPnt As Variant
    Dim varCancel As Variant
    On Error GoTo Err_Control
    Set objUtil = ThisDrawing.Utility
    objUtil.GetEntity objTemp, varPnt, vbCrLf & strPrmt
    Set EntSel = objTemp
    If Not IsMissing(vPoint) Then
        vPoint = objUtil.TranslateCoordinates(varPnt, acUCS, acWorld, False)  'Added
    End If
Exit_Here:
    Exit Function
Err_Control:
    Select Case Err.Number
        Case -2147352567
        'Debug.Print Err.Number, Err.Description
        varCancel = ThisDrawing.GetVariable("LASTPROMPT")
        If InStr(1, varCancel, "*Cancel*") <> 0 Then
            If GetAsyncKeyState(VK_ESCAPE) And 8000 > 0 Then
                Err.Clear
                Resume Exit_Here
            ElseIf GetAsyncKeyState(VK_LBUTTON) > 0 Then
                Err.Clear
                Resume
            End If
        Else
            If GetAsyncKeyState(VK_SPACE) Then
                Resume Exit_Here
            End If
            'Missed the pick, send them back!
            Err.Clear
            Resume
        End If
        Case Else
            MsgBox Err.Description
            Resume Exit_Here
    End Select
End Function
« Last Edit: April 09, 2008, 06:04:24 PM by Bryco »