VBA在图纸空间中的创建的标注如何与模型关联呢？

nhy12345678

用VBA在图纸空间中标注的尺寸标注线型比例是1，而CAD的dli命令会自动修改这个标注线型比例的，用VBA如何自动修改这个标注线型比例呢，或者能得到当前视口的比例系数也可以啊！亲高手们指点。。。

代码如下：

Sub dli()
    Dim dimObj As AcadDimRotated
    Dim p1 As Variant
    Dim p2 As Variant
    Dim p3 As Variant
    Dim rotAngle As Double
    Dim rotAngleNunmer As Integer
    rotAngleNunmer = 1
    With ThisDrawing.Utility
        p1 = (.GetPoint(, "请指定标注起始点(按Esc或Enter或左健退出):"))
        If IsEmpty(p1) Then Exit Sub
    End With
    With ThisDrawing.Utility
        p2 = (.GetPoint(, "请指定标注结束点(按Esc或Enter或左健退出):"))
        If IsEmpty(p2) Then Exit Sub
    End With
    With ThisDrawing.Utility
        p3 = (.GetPoint(, "请指定标注基准点(按Esc或Enter或左健退出):"))
        If IsEmpty(p3) Then Exit Sub
    End With
    On Error Resume Next
    If p1(0) < p2(0) Then 'p1点在左边
       If p3(0) > p1(0) And p3(0) < p2(0) Then 'p3点X在p1 p2中间
          If p3(1) < p1(1) And p3(1) < p2(1) Then 'p3点Y在p1 p2下方
             rotAngleNunmer = 1
          End If
          If p3(1) > p1(1) And p3(1) > p2(1) Then 'p3点Y在p1 p2上方
             rotAngleNunmer = 2
          End If
       End If
    End If
    If p1(0) > p2(0) Then 'p1点在右边
       If p3(0) > p2(0) And p3(0) < p1(0) Then 'p3点X在p1 p2中间
          If p3(1) < p1(1) And p3(1) < p2(1) Then 'p3点Y在p1 p2下方
             rotAngleNunmer = 1
          End If
          If p3(1) > p1(1) And p3(1) > p2(1) Then 'p3点Y在p1 p2上方
             rotAngleNunmer = 2
          End If
       End If
    End If
     If p2(1) > p1(1) Then 'p1点在下边
       If p3(1) > p1(1) And p3(1) < p2(1) Then 'p3点y在p1 p2中间
          If p3(0) < p1(0) And p3(0) < p2(0) Then 'p3点x在p1 p2左方
             rotAngleNunmer = 3
          End If
          If p3(0) > p1(0) And p3(0) > p2(0) Then 'p3点Y在p1 p2右方
             rotAngleNunmer = 4
          End If
       End If
    End If
     If p1(1) > p2(1) Then 'p1点在上边
       If p3(1) > p2(1) And p3(1) < p1(1) Then 'p3点y在p1 p2中间
          If p3(0) < p1(0) And p3(0) < p2(0) Then 'p3点x在p1 p2左方
             rotAngleNunmer = 3
          End If
          If p3(0) > p1(0) And p3(0) > p2(0) Then 'p3点Y在p1 p2右方
             rotAngleNunmer = 4
          End If
       End If
    End If
    Select Case rotAngleNunmer
        Case 1, 2
            rotAngle = 0
        Case 3, 4
            rotAngle = 90
    End Select
    rotAngle = rotAngle * 3.141592 / 180#       ' covert to Radians
    If ThisDrawing.ActiveSpace = acPaperSpace Then '当前为图纸空间
       Set dimObj = ThisDrawing.PaperSpace.AddDimRotated(p1, p2, p3, rotAngle)
    Else
       Set dimObj = ThisDrawing.ModelSpace.AddDimRotated(p1, p2, p3, rotAngle)
    End If
    dimObj.Layer = "标注"
    ThisDrawing.SendCommand "dco" & vbCr
End Sub