Topic: How do I get the extension of a selected dimension

[Humbertogo]

How can i get the extension  defining point X and Y from a select Dimension?

for example

1st extension  defining point: X=   0.0000  Y=   0.0000  Z=   0.0000
2nd extension  defining point: X=   2.0000  Y=   0.0000  Z=   0.0000
dimension line defining point: X=   2.0000  Y=   0.6359  Z=   0.0000

[Kerry]

You could try the DXF values as indicated by this ..

Code: [Select]

;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;
(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)
)

;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;

Command: LIST

Select objects: 1 found

Select objects:

                  DIMENSION  Layer: "ST-DIM"
                            Space: Model space
                   Handle = 1d56
associative: no
type: horizontal
1st extension  defining point: X=  3970.67  Y=  1540.87  Z=     0.00
2nd extension  defining point: X=  5294.07  Y=  1949.35  Z=     0.00
dimension line defining point: X=  5294.07  Y=  2486.82  Z=     0.00
default text position: X=  4632.37  Y=  2521.83  Z=     0.00
default text
dimension style: "STD35$0"
dimension style overrides:
 DIMADEC     1
 DIMSCALE    10.00

Command: dxflist

Select entity to display its DXF value data:
(-1 . <Entity name: 7ef6e7b0>)
(0 . "DIMENSION")
(330 . <Entity name: 7ef68cf8>)
(5 . "1D56")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "ST-DIM")
(100 . "AcDbDimension")
(2 . "*D108")
(10 5294.07 2486.82 0.0)
(11 4632.37 2521.83 0.0)
(12 0.0 0.0 0.0)
(70 . 32)
(1 . "")
(71 . 5)
(72 . 1)
(41 . 1.0)
(42 . 1323.4)
(52 . 0.0)
(53 . 0.0)
(54 . 0.0)
(51 . 0.0)
(210 0.0 0.0 1.0)
(3 . "STD35$0")
(100 . "AcDbAlignedDimension")
(13 3970.67 1540.87 0.0)
(14 5294.07 1949.35 0.0)
(15 0.0 0.0 0.0)
(16 0.0 0.0 0.0)
(40 . 0.0)
(50 . 0.0)
(100 . "AcDbRotatedDimension")
(-3 ("ACAD" (1000 . "DSTYLE") (1002 . "{") (1070 . 40) (1040 . 10.0) (1070 .
179) (1070 . 1) (1002 . "}")))

[Humbertogo]

But how to do it from vba?
i know that you can get the  extension  defining point from a AlignedDimension

ExtLine1Point
ExtLine2Point


but not from RotatedDimension

[Kerry]

Sorry, I didn't notice this was in a VBA forum ..

[Kerry]

I believe the points are not exposed to ActiveX for Rotated Dimensions.

edit :
I believe the points for Rotated Dimensions are not exposed in ActiveX .

[Humbertogo]

that is  true
you are right

[Bryco]

Lisp is the way

Code: [Select]

'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
And an example

Code: [Select]

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