社区 › VB › AcadDimRotated的起点和终点

Humbertogo 发表于 2007-5-29 09:24:31

AcadDimRotated的起点和终点

如何获取 AcadDimRotated 的起始点
和端点，以及如何分解 AcadDimension
**** Hidden Message *****

Bryco 发表于 2007-5-29 10:47:32

基本上通过使用lisp dxf代码13，14
把它放在你的子
varTest = vbAssoc（objDim， 13）
StartPt = ParseDxfPoint（varTest）

varTest = vbAssoc（objDim， 14）
EndPt = ParseDxfPoint（varTest）
Function ParseDxfPoint(DxfPoint)
    Dim Pt(2) As Double
    Dim Gap1, Gap2
    Gap1 = InStr(2, DxfPoint, " ", vbTextCompare)
    Pt(0) = Mid(DxfPoint, 2, Gap1 - 1)
    Gap2 = InStr(Gap1 + 1, DxfPoint, " ", vbTextCompare)
    Pt(1) = Mid(DxfPoint, Gap1 + 1, Gap2 - (Gap1 + 1))
    Pt(2) = Mid(DxfPoint, Gap2 + 1, Len(DxfPoint) - (Gap2 + 1))
    ParseDxfPoint = Pt
   
End Function
'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 vbAssoc2(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
strHnd = pAcadObj.Handle
If TypeOf pAcadObj Is AcadBlock Then
    strHnd = Hex(1 + Val("&H" & strHnd))
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)
vbAssoc2 = 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

Humbertogo 发表于 2007-5-29 10:50:34

谢啦

查看完整版本: AcadDimRotated的起点和终点