[例程]使用Utility

mccad

Public Sub UseGetConer()
   
    Dim returnPnt As Variant
    Dim basePnt As Variant
    'basePnt(0) = 2#: basePnt(1) = 2#: basePnt(2) = 0#
   
    basePnt = ThisDrawing.Utility.GetPoint(, "选择第1个角点：")
   
    ' Prompt the user to pick second point and returns the point
    returnPnt = ThisDrawing.Utility.GetCorner(basePnt, "输入第2个角点： ")

   
    ' Display the point picked
    MsgBox "第2个角点的坐标为：" & returnPnt(0) & ", " & returnPnt(1) & ", " & returnPnt(2), , "GetCorner Example"

End Sub

Public Sub UseGetAngle()
   
    Dim pickObj As AcadEntity
    Dim pickPnt As Variant
    ThisDrawing.Utility.GetEntity pickObj, pickPnt
'-------------------------------
    Dim retAngle As Double
    Dim basePnt As Variant
    basePnt = ThisDrawing.Utility.GetPoint(, "选择一个基点：")
   
    ' Return the angle in radians with a prompt
    retAngle = ThisDrawing.Utility.GetAngle(, "输入一个角度: ")
    'MsgBox "输入的角度值为：" & retAngle
   
    ' Return the angle in radians with a prompt and an angle base point
    'basePnt(0) = 2#: basePnt(1) = 2#: basePnt(2) = 0#
    'retAngle = ThisDrawing.Utility.GetAngle(basePnt, "输入一个角度: ")
    'MsgBox "输入的角度值为：" & retAngle
'---------------------------------
    pickObj.Rotate basePnt, retAngle
   
End Sub

Public Sub UseGetKeyword()
   
    ' Define the list of valid keywords
    Dim kwordList As String
    kwordList = "Width Height Depth"
    ThisDrawing.Utility.InitializeUserInput 1, kwordList
            
    ' Prompt the user to input any of the keywords. Return "Width", "Height" or "Depth" in
    ' the returnString variable depending on whether the user input "W", "H" or "D".
    Dim returnString As String
    returnString = ThisDrawing.Utility.GetKeyword _
                   ("选择高(H)/宽(W)/深(D): ")
    MsgBox "你选择的是：" & returnString

End Sub

Public Sub CreateSector()
   
    '声明用于创建区域的对象数组
    Dim curves(0 To 1) As AcadEntity

    '声明有关创建圆弧的变量
    Dim centerPoint As Variant
    Dim radius As Double
    Dim startAngle As Double
    Dim endAngle As Double

    '给圆弧变量赋值
    centerPoint = ThisDrawing.Utility.GetPoint(, "选择圆弧中心：")
    radius = ThisDrawing.Utility.GetReal("给定圆弧半径：")
    startAngle = ThisDrawing.Utility.GetReal("给定起始角：") * 3.141592 / 180
    endAngle = ThisDrawing.Utility.GetReal("给定终止角：") * 3.141592 / 180
    '绘制圆弧段
    Set curves(0) = ThisDrawing.ModelSpace.AddArc _
                    (centerPoint, radius, startAngle, endAngle)
    '绘制直线段
    Set curves(1) = ThisDrawing.ModelSpace.AddLine _
                    (curves(0).StartPoint, curves(0).EndPoint)
        
    '创建由圆弧和直线段构成的区域
    Dim keywordList As String
    Dim ynValue As String
    keywordList = "Yes No"
    ThisDrawing.Utility.InitializeUserInput 1, keywordList
    ynValue = ThisDrawing.Utility.GetKeyword("创建区域(Y)/不创建区域(N)： ")
   
    If StrComp(ynValue, "Yes", 1) = 0 Then
        Dim regionObj As Variant
        regionObj = ThisDrawing.ModelSpace.AddRegion(curves)
        regionObj(0).Color = acCyan
        MsgBox "区域已创建完毕！"
    Else
        MsgBox "没有创建区域！"
    End If
   
    ZoomAll
        
End Sub

Public Sub RegionMove()
   
    Dim pickObj As AcadEntity
    Dim pickPnt As Variant
    ThisDrawing.Utility.GetEntity pickObj, pickPnt
   
    Dim movePnt1 As Variant
    Dim movePnt2 As Variant
    movePnt1 = ThisDrawing.Utility.GetPoint(, "选择移动基点：")
    movePnt2 = ThisDrawing.Utility.GetPoint(movePnt1, "选择移动终点：")
   
    pickObj.Move movePnt1, movePnt2

End Sub

Public Sub UseGetInput()
   
    On Error Resume Next
   
    '定义一个关键词列表
    Dim keywordList As String
    keywordList = "Keyword1 Keyword2"
    '允许Getxxx方法输入任何形式的值
    ThisDrawing.Utility.InitializeUserInput 128, keywordList
   
    ' Get the user input
    Dim returnPnt As Variant
    returnPnt = ThisDrawing.Utility.GetPoint _
                (, "输入Keyword1或Keyword2: ")
    If Err Then                         '如果输入发生错误
         '判断错误信息是否为输入关键词
         If StrComp(Err.Description, _
                    "User input is a keyword", 1) = 0 Then
         '如果是要输入关键词，用GetInput截获
             Dim inputString As String
             Err.Clear
             inputString = ThisDrawing.Utility.GetInput
             MsgBox "You entered the keyword: " & inputString
         Else
             MsgBox "使用GetPoint方法时出现了" & _
                     Err.Description & "错误。"
             Err.Clear
         End If
    Else                               '如果正常地输入了点坐标
        MsgBox "点的WCS坐标为: " & returnPnt(0) & ", " & _
                returnPnt(1) & ", " & returnPnt(2)
    End If

End Sub

Public Sub UseGetSubEntity()
   
    Dim subObj As AcadEntity
    Dim PickedPoint As Variant
    Dim TransMatrix As Variant
    Dim ContextData As Variant
    Dim HasContextData As String
   
    On Error GoTo NOT_ENTITY
        
    '获取被选择图元的有关信息
    ThisDrawing.Utility.GetSubEntity subObj, PickedPoint, _
                                     TransMatrix, ContextData
   
    '判断是否有子图元存在
    HasContextData = IIf(VarType(ContextData) = _
                      vbEmpty, "没有", "有")
   
    MsgBox "被选对象类型名: " & TypeName(subObj) & vbCrLf & _
           "拾取点坐标:     " & PickedPoint(0) & ", " & _
                                PickedPoint(1) & ", " & _
                                PickedPoint(2) & vbCrLf & _
           "该对象" & HasContextData & "嵌套对象。"
   
    Dim I As Integer
   
    MsgBox "被选择对象为第 " & UBound(ContextData) & " 嵌套层."
    '显示由里向外嵌套图元的ObjectID
    For I = LBound(ContextData) To UBound(ContextData)
        MsgBox "第" & UBound(ContextData) - I & _
               "嵌套层的ObjectID: " & ContextData(I)
    Next
   
    subObj.Color = acGreen
    ThisDrawing.Regen True
   
    Exit Sub
   
NOT_ENTITY:
    '若没有选择图元或图元不具备嵌套的能力
    MsgBox ("该图元不具有子图元。")

End Sub

Public Sub RotateEntity()

Dim pickObj As AcadEntity         '保存被选择图元的对象变量
Dim pickPnt As Variant            '选择图元时的拾取点变量
ThisDrawing.Utility.GetEntity pickObj, pickPnt, "选择图元对象："

Dim rotAng As Double              '保存旋转角的变量
Dim basePnt As Variant            '保存基点的变量
rotAng = ThisDrawing.Utility.GetReal("输入旋转角：")
rotAng = rotAng * 3.141592 / 180  '将角度转换成弧度
basePnt = ThisDrawing.Utility.GetPoint(, "选择旋转基点：")

'旋转被选择的图元
pickObj.Rotate basePnt, rotAng

End Sub