AutoCAD VBA getKeywords实例

Public Sub TestKeyWords()
    AppActivate ThisDrawing.Application.Caption
    Dim kwordList As Variant, kws1 As String, kws2 As String, rtn As String
    kwordList = Array("WHITE", "YELLOW", "RED", "BLUE", "EXIT", "ChangeRdius")
    kws1 = VBA.Join(kwordList, " "): kws2 = VBA.Join(kwordList, "/")
    Dim pt As Variant, flag As Boolean, color As Integer, r As Double
    r = 300#
    flag = True
    While flag
        On Error Resume Next
        pt = ThisDrawing.Utility.GetPoint(, "pick a point to draw circle" & " or Enter a keyword [" & kws2 & "]: ")
        ThisDrawing.Utility.InitializeUserInput 0, kws1
        If Err Then
            Err.Clear
            rtn = ThisDrawing.Utility.GetInput
            Select Case rtn
                Case "YELLOW"
                    color = acYellow
                Case "RED"
                    color = acRed
                Case "BLUE"
                    color = acBlue
                Case "EXIT"
                    flag = False
                    Exit Sub
                Case "ChangeRdius"
                    r = ThisDrawing.Utility.GetReal("输入半径:")
                    If r < 0 Then r = 300#
                Case Else
                    color = 0
            End Select
        Else
            With ThisDrawing.ModelSpace.AddCircle(pt, r)
                .color = color
            End With
        End If
    Wend
End Sub