'***********************************************************************************************

'坡度标注***********************************************坡度标注**********************************
 
Sub DimPD()
 
    Dim H As Integer
    '默认文字标注高度
    H = ThisDrawing.GetVariable("DIMTXT")                               
    ThisDrawing.Utility.InitializeUserInput 1, ""
    '用户可以再屏幕上面点两点获取值（两的间的距离）
    'GetDistance可以接受用户输入，比用GetInteger要好。
    H = ThisDrawing.Utility.GetDistance("标注文字高度(" & H & "):")     
                                                                        
    '错误检查
    '用户按下Esc键，则退出.(错误代码可以通过MsgBox提示获得)
    If Err.Number = -2147352567 Then                                   
        Err.Clear
        Exit Sub
    ElseIf Err Then
   '如果用户按下 enter 按钮或者输入有误，行距使用默认文字行距                                                   
        H = ThisDrawing.GetVariable("DIMTXT")
        Err.Clear
    End If
     
     
    Dim P1 As Variant
    Dim P2 As Variant
    Dim i As Double
    Dim PDString As String
    Dim PDText As AcadText
    
Redraw:
     On Error GoTo Ex:
     
     ThisDrawing.Utility.InitializeUserInput 1, ""
     P1 = ThisDrawing.Utility.GetPoint(, "在你要标注的直线上任意选取两点,第一点：")
     ThisDrawing.Utility.InitializeUserInput 1, ""
     P2 = ThisDrawing.Utility.GetPoint(, "在你要标注的直线上任意选取两点,第二点：")
     i = (P2(1) - P1(1)) / (P2(0) - P1(0))                                    '计算坡度
     PDString = 1 & ":" & Format(Abs(1 / i), "0.0000")                  '坡度精确到小数点后面四位数
     ThisDrawing.Utility.InitializeUserInput 1, ""
     P1 = ThisDrawing.Utility.GetPoint(, "选择标注基点：")
     Set PDText = ThisDrawing.ModelSpace.AddText(PDString, P1, H)
     PDText.Rotate P1, Atn(i)                                                   '标注文字和直线平行
     GoTo Redraw:
Ex:
     Exit Sub
 End Sub