如何获得选定维度的扩展

;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;
(defun c:dxflist (/ eko)
  (setq eko (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq *lent*
         (entget
           (car (entsel "\nSelect entity to display its DXF value data: ")
           )
           '("*")
         )
  )
  (textscr)
  (list *lent*)
  (foreach n *lent* (print n))
  (setvar "cmdecho" eko)
  (princ)
)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;

'SomeCallMeDave
'http://www.vbdesign.net/expresso/showthread.php?postid=83887#post83887
'Changed pAcadObj As AcadObject to pAcadObj As Object to access imagedef as well
'Modified by Jeff Mishler, March 2006, to get the Block table object, not Block_Record table object
Public Function vbAssoc(pAcadObj, pDXFCode As Integer) As Variant
Dim VLisp As Object
Dim VLispFunc As Object
Dim varRetVal As Variant
Dim obj1 As Object
Dim obj2 As Object
Dim strHnd As String
Dim strVer As String
Dim lngCount As Long
Dim i As Long
Dim j As Long
On Error GoTo vbAssocError
    
If Left(ThisDrawing.Application.Version, 2) = "16" Then
  Set VLisp = ThisDrawing.Application.GetInterfaceObject("VL.Application.16")
Else
  Set VLisp = ThisDrawing.Application.GetInterfaceObject("VL.Application.1")
End If
Set VLispFunc = VLisp.ActiveDocument.Functions
If Not TypeOf pAcadObj Is AcadBlock Then
    strHnd = pAcadObj.Handle
Else
    Dim lispStr As String
    lispStr = "(cdr (assoc 5 (entget (tblobjname " & Chr(34) & "Block" & Chr(34) & Chr(34) & pAcadObj.Name & Chr(34) & "))))"
    Set obj1 = VLispFunc.Item("read").Funcall(lispStr)
    strHnd = VLispFunc.Item("eval").Funcall(obj1)
End If
Set obj1 = VLispFunc.Item("read").Funcall("pDXF")
  varRetVal = VLispFunc.Item("set").Funcall(obj1, pDXFCode)
Set obj1 = VLispFunc.Item("read").Funcall("pHandle")
  varRetVal = VLispFunc.Item("set").Funcall(obj1, strHnd)
Set obj1 = VLispFunc.Item("read").Funcall("(vl-princ-to-string (cdr (assoc pDXF (entget (handent pHandle)))))")
  varRetVal = VLispFunc.Item("eval").Funcall(obj1)
vbAssoc = varRetVal
'clean up the newly created LISP symbols
Set obj1 = VLispFunc.Item("read").Funcall("(setq pDXF nil)")
  varRetVal = VLispFunc.Item("eval").Funcall(obj1)
Set obj1 = VLispFunc.Item("read").Funcall("(setq pHandle nil)")
  varRetVal = VLispFunc.Item("eval").Funcall(obj1)
'release the objects or Autocad gets squirrely (no offense RR)
Set obj2 = Nothing
Set obj1 = Nothing
Set VLispFunc = Nothing
Set VLisp = Nothing
Exit Function
vbAssocError:
  Set obj2 = Nothing
  Set obj1 = Nothing
  Set VLispFunc = Nothing
  Set VLisp = Nothing
  MsgBox "Error occurred " & Err.Description
End Function

Public Function DimRotation(objDim As AcadDimension, varPick As Variant)
'code(10)=cross point rhs of text,arrow2
'code(11)= text insertpt
'code(13) =Dimstartpt-extendline1
'code(14) =DimEndpt-extendline2
    Dim dblRot As Double
    Dim dblStartToVarPickAng As Double, dblEndAng As Double
    Dim dblEndToVarPickAng As Double
    Dim StartPt, EndPt, arrow2Pt
    Dim varTest As Variant, Ppt, X(1)
    With ThisDrawing.Utility
    
        'dblRot = vbAssoc(objDim, 50)
           
        varTest = vbAssoc(objDim, 10)
        arrow2Pt = ParseDxfPoint(varTest)
           
        varTest = vbAssoc(objDim, 13)
        StartPt = ParseDxfPoint(varTest)
    
        varTest = vbAssoc(objDim, 14)
        EndPt = ParseDxfPoint(varTest)
        
        dblEndAng = .AngleFromXAxis(EndPt, arrow2Pt)
                
        X(1) = dblEndAng - 0.5 * Pi
        
        Dim dblDist As Double
        dblDist = objDim.ExtensionLineExtend * objDim.ScaleFactor
        Ppt = .PolarPoint(arrow2Pt, dblEndAng, dblDist)
        
        dblStartToVarPickAng = .AngleFromXAxis(StartPt, varPick)
        If dblStartToVarPickAng > (2 * Pi) - 0.001 Then
            dblStartToVarPickAng = dblStartToVarPickAng - 2 * Pi
        End If
        
        dblEndToVarPickAng = .AngleFromXAxis(EndPt, varPick)
        If dblEndToVarPickAng > (2 * Pi) - 0.001 Then
              dblEndToVarPickAng = dblEndToVarPickAng - 2 * Pi
        End If
       
        If Abs(dblStartToVarPickAng - dblEndAng) _
            < Abs(dblEndToVarPickAng - dblEndAng) Then
            
            dblRot = dblEndAng + 0.5 * Pi * isLeft(EndPt, arrow2Pt, StartPt) 'function
            Ppt = .PolarPoint(Ppt, dblRot, objDim.Measurement)
        End If
        
        X(0) = Ppt
        DimRotation = X
        
    End With
End Function