TheSwamp
Code Red => VB(A) => Topic started by: Humbertogo on August 10, 2006, 04:05:57 AM
-
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
-
You could try the DXF values as indicated by this ..
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;
(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 . "}")))
-
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
-
Sorry, I didn't notice this was in a VBA forum ..
-
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 .
-
that is true
you are right
-
Lisp is the way
'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
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