有什么办法可以取得天正对象的坐标么？

lennie

我想用VBA获取天正文字的坐标，用网站提供的函数GetDXFCodeValue

2. Public Function GetDXFCodeValue(ent As Object, gCode As Integer) As Variant
   
3.     Dim retval
   
4.     Dim obj As New CL
   
5.         retval = obj.EvalLispExpression("(cdr (assoc " & gCode & " (entget(handent " & Chr(34) & ent.Handle & Chr(34) & "))))")
   
6.         GetDXFCodeValue = retval
   
7.         Set obj = Nothing
   
8. End Function

Public Function GetDXFCodeValue(ent As Object, gCode As Integer) As Variant<br />     Dim retval<br />     Dim obj As New CL<br />         retval = obj.EvalLispExpression("(cdr (assoc " & gCode & " (entget(handent " & Chr(34) & ent.Handle & Chr(34) & "))))")<br />         GetDXFCodeValue = retval<br />         Set obj = Nothing<br /> End Function

GetDXFCodeValue(ent,10) 时出错，请问有什么办法可以取得天正对象的坐标么？

aihuyujian

直接(cdr (assoc 10 （entget dx）))

lennie

aihuyujian  怎么把这个点传递给VBA啊

lennie

自己解决了

2. '获取图元组码
   
3. Public Function GetDXFCodeValue(Ent As Object, gCode As Integer) As Variant
   
4.     Dim retval
   
5.     Dim Obj As New CL
   
6.         retval = Obj.EvalLispExpression("(cdr (assoc " & gCode & " (entget (handent " & Chr(34) & Ent.Handle & Chr(34) & "))))")
   
7.         GetDXFCodeValue = retval
   
8.         Set Obj = Nothing
   
9. End Function
   
10. 
    
11. '获取图元组码(点坐标)
    
12. Function GetDxfPoint(Ent As Object, gCode As Integer) As Variant
    
13.     Dim retval
    
14.     Dim aPoint(2) As Double
    
15.     Dim Obj As New CL
    
16.         retval = Obj.EvalLispExpression("(car(cdr (assoc " & gCode & " (entget (handent " & Chr(34) & Ent.Handle & Chr(34) & ")))))")
    
17.         aPoint(0) = retval
    
18.         retval = Obj.EvalLispExpression("(car (cdr (cdr (assoc " & gCode & " (entget (handent " & Chr(34) & Ent.Handle & Chr(34) & "))))))")
    
19.         aPoint(1) = retval
    
20.         GetDxfPoint = aPoint
    
21.         Set Obj = Nothing
    
22. End Function

'获取图元组码<br /> Public Function GetDXFCodeValue(Ent As Object, gCode As Integer) As Variant<br />     Dim retval<br />     Dim Obj As New CL<br />         retval = Obj.EvalLispExpression("(cdr (assoc " & gCode & " (entget (handent " & Chr(34) & Ent.Handle & Chr(34) & "))))")<br />         GetDXFCodeValue = retval<br />         Set Obj = Nothing<br /> End Function<br /> <br /> '获取图元组码(点坐标)<br /> Function GetDxfPoint(Ent As Object, gCode As Integer) As Variant<br />     Dim retval<br />     Dim aPoint(2) As Double<br />     Dim Obj As New CL<br />         retval = Obj.EvalLispExpression("(car(cdr (assoc " & gCode & " (entget (handent " & Chr(34) & Ent.Handle & Chr(34) & ")))))")<br />         aPoint(0) = retval<br />         retval = Obj.EvalLispExpression("(car (cdr (cdr (assoc " & gCode & " (entget (handent " & Chr(34) & Ent.Handle & Chr(34) & "))))))")<br />         aPoint(1) = retval<br />         GetDxfPoint = aPoint<br />         Set Obj = Nothing<br /> End Function