Kerry 发表于 2006-8-10 04:05:57

如何获得选定维度的扩展

我如何获得分机；从选定尺寸定义点X和Y
例如，第一个扩展；定义点：X=&nbsp；0.0000；Y=&nbsp；0.0000；Z=&nbsp；0.0000第二次扩展；定义点：X=&nbsp；2.0000；Y=&nbsp；0.0000；Z=&nbsp；0.0000尺寸线定义点：X=&nbsp；2.0000；Y=&nbsp；0.6359；Z=&nbsp；0

Kerry 发表于 2006-8-10 04:15:30

您可以尝试如下所示的DXF值;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;
(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)
)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;

Kerry 发表于 2006-8-10 04:32:11

但是如何从vba中实现呢
我知道你可以得到；扩展；从对齐维度定义点，但不从旋转维度定义点

Bryco 发表于 2006-8-10 04:38:57

对不起，我没有&#039；我注意到这是在VBA论坛上。。

Kerry 发表于 2006-8-10 04:50:49


我相信对于旋转尺寸，这些点不会暴露在ActiveX中
编辑：我相信ActiveX中没有显示旋转尺寸的点。

Kerry 发表于 2006-8-10 05:00:32

也就是说；真的，你说得对

Bryco 发表于 2006-8-10 10:17:47

Lisp就是这样'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
页: [1]
查看完整版本: 如何获得选定维度的扩展