ARX的COM函数库之实体篇(acdbEntGet)

efan2000

通过acdbEntMake可以创建对象，创建之后可以通过acdbEntLast获取最后创建的对象，再通过acdbEntGet可以查询对象的信息。

1. ' 创建直线
   
2. Sub testAcdbEntMakeLine()
   
3.     Dim ct(0 To 2) As Integer
   
4.     Dim cv(0 To 2) As Variant
   
5.     ct(0) = 0
   
6.     cv(0) = "LINE"
   
7.     Dim pt1(0 To 2) As Double
   
8.     ct(1) = 10 ' 起点
   
9.     cv(1) = pt1
   
10.     Dim pt2(0 To 2) As Double
    
11.     pt2(0) = 10
    
12.     ct(2) = 11 ' 端点
    
13.     cv(2) = pt2
    
14.     Debug.Print AcdbEntMake(ct, cv)
    
15.     testAcdbEntLast
    
16. End Sub
    
17. 
    
18. ' 创建直线-新版
    
19. Sub testAcdbEntMakeLine()
    
20.     Dim ent As ResultBuffer
    
21.     Set ent = New ResultBuffer
    
22.     ent.AddTypedValue 0, "LINE"
    
23.     Dim pt1(0 To 2) As Double
    
24.     ent.AddTypedValue 10, pt1 ' 起点
    
25.     Dim pt2(0 To 2) As Double
    
26.     pt2(0) = 10
    
27.     ent.AddTypedValue 11, pt2 ' 端点
    
28.     Debug.Print AcdbEntMake(ent)
    
29. End Sub
    
30. 
    
31. ' 获取最后创建对象
    
32. Sub testAcdbEntLast()
    
33.     Dim v As Variant
    
34.     Debug.Print AcdbEntLast(v)
    
35.     testAcdbEntGet v
    
36. End Sub
    
37. 
    
38. ' 获取对象组码
    
39. Sub testAcdbEntGet(ByVal ent As Variant)
    
40.     Dim t As Variant
    
41.     Dim v As Variant
    
42.     AcdbEntGet ent, t, v
    
43.     Dim s As String
    
44.     s = "("
    
45.     Dim i As Integer
    
46.     For i = 0 To UBound(t)
    
47.         If i <> 0 Then
    
48.             s = s & " "
    
49.         End If
    
50.         If (t(i) = -1) Or (t(i) >= 330 And t(i) <= 369) Then
    
51.             s = s & "(" & t(i) & " . " & "<图元名: " & LCase(Hex(v(i)(0))) & ">" & ")"
    
52.         ElseIf (t(i) >= 0 And t(i) <= 9) Or (t(i) >= 100 And t(i) <= 109) Or (t(i) >= 410 And t(i) <= 419) Then
    
53.             s = s & "(" & t(i) & " . " & """" & v(i) & """" & ")"
    
54.         ElseIf (t(i) >= 10 And t(i) <= 17) Or (t(i) >= 210 And t(i) <= 219) Then
    
55.             s = s & "(" & t(i) & " " & Format(v(i)(0), "0.0" & String(5 - IIf(Abs(Fix(v(i)(0))) = 0, 0, Len(Abs(Fix(v(i)(0))))), "#")) & " " & Format(v(i)(1), "0.0" & String(5 - IIf(Abs(Fix(v(i)(1))) = 0, 0, Len(Abs(Fix(v(i)(1))))), "#")) & " " & Format(v(i)(2), "0.0" & String(5 - IIf(Abs(Fix(v(i)(2))) = 0, 0, Len(Abs(Fix(v(i)(2))))), "#")) & ")"
    
56.         ElseIf (t(i) >= 38 And t(i) <= 59) Or (t(i) >= 140 And t(i) <= 149) Then
    
57.             s = s & "(" & t(i) & " . " & Format(v(i), "0.0" & String(5 - IIf(Abs(Fix(v(i))) = 0, 0, Len(Abs(Fix(v(i))))), "#")) & ")"
    
58.         Else
    
59.             s = s & "(" & t(i) & " . " & v(i) & ")"
    
60.         End If
    
61.     Next
    
62.     s = s & ")"
    
63.     Debug.Print s
    
64. End Sub
    
65. 
    
66. 
    
67. ' 获取对象组码-新版
    
68. Sub testAcdbEntGet(ByVal ent As Variant)
    
69.     Dim rb As ResultBuffer
    
70.     Set rb = AcdbEntGet(ent)
    
71.     Dim v As Variant
    
72.     v = rb.AsArray()
    
73.     Dim s As String
    
74.     s = "("
    
75.     Dim i As Integer
    
76.     For i = 0 To UBound(v)
    
77.         Dim tv As TypedValue
    
78.         Set tv = v(i)
    
79.         If i <> 0 Then
    
80.             s = s & " "
    
81.         End If
    
82.         If (tv.TypeCode = -1) Or (tv.TypeCode >= 330 And tv.TypeCode <= 369) Then
    
83.             s = s & "(" & tv.TypeCode & " . " & "<图元名: " & LCase(Hex(tv.Value(0))) & ">" & ")"
    
84.         ElseIf (tv.TypeCode >= 0 And tv.TypeCode <= 9) Or (tv.TypeCode >= 100 And tv.TypeCode <= 109) Or (tv.TypeCode >= 410 And tv.TypeCode <= 419) Then
    
85.             s = s & "(" & tv.TypeCode & " . " & """" & tv.Value & """" & ")"
    
86.         ElseIf (tv.TypeCode >= 10 And tv.TypeCode <= 17) Or (tv.TypeCode >= 210 And tv.TypeCode <= 219) Then
    
87.             s = s & "(" & tv.TypeCode & " " & Format(tv.Value(0), "0.0" & String(5 - IIf(Abs(Fix(tv.Value(0))) = 0, 0, Len(Abs(Fix(tv.Value(0))))), "#")) & " " & Format(tv.Value(1), "0.0" & String(5 - IIf(Abs(Fix(tv.Value(1))) = 0, 0, Len(Abs(Fix(tv.Value(1))))), "#")) & " " & Format(tv.Value(2), "0.0" & String(5 - IIf(Abs(Fix(tv.Value(2))) = 0, 0, Len(Abs(Fix(tv.Value(2))))), "#")) & ")"
    
88.         ElseIf (tv.TypeCode >= 38 And tv.TypeCode <= 59) Or (tv.TypeCode >= 140 And tv.TypeCode <= 149) Then
    
89.             s = s & "(" & tv.TypeCode & " . " & Format(tv.Value, "0.0" & String(5 - IIf(Abs(Fix(tv.Value)) = 0, 0, Len(Abs(Fix(tv.Value)))), "#")) & ")"
    
90.         Else
    
91.             s = s & "(" & tv.TypeCode & " . " & tv.Value & ")"
    
92.         End If
    
93.     Next
    
94.     s = s & ")"
    
95.     Debug.Print s
    
96. End Sub

' 创建直线<br /> Sub testAcdbEntMakeLine()<br />     Dim ct(0 To 2) As Integer<br />     Dim cv(0 To 2) As Variant<br />     ct(0) = 0<br />     cv(0) = "LINE"<br />     Dim pt1(0 To 2) As Double<br />     ct(1) = 10 ' 起点<br />     cv(1) = pt1<br />     Dim pt2(0 To 2) As Double<br />     pt2(0) = 10<br />     ct(2) = 11 ' 端点<br />     cv(2) = pt2<br />     Debug.Print AcdbEntMake(ct, cv)<br />     testAcdbEntLast<br /> End Sub<br /> <br /> ' 创建直线-新版<br /> Sub testAcdbEntMakeLine()<br />     Dim ent As ResultBuffer<br />     Set ent = New ResultBuffer<br />     ent.AddTypedValue 0, "LINE"<br />     Dim pt1(0 To 2) As Double<br />     ent.AddTypedValue 10, pt1 ' 起点<br />     Dim pt2(0 To 2) As Double<br />     pt2(0) = 10<br />     ent.AddTypedValue 11, pt2 ' 端点<br />     Debug.Print AcdbEntMake(ent)<br /> End Sub<br /> <br /> ' 获取最后创建对象<br /> Sub testAcdbEntLast()<br />     Dim v As Variant<br />     Debug.Print AcdbEntLast(v)<br />     testAcdbEntGet v<br /> End Sub<br /> <br /> ' 获取对象组码<br /> Sub testAcdbEntGet(ByVal ent As Variant)<br />     Dim t As Variant<br />     Dim v As Variant<br />     AcdbEntGet ent, t, v<br />     Dim s As String<br />     s = "("<br />     Dim i As Integer<br />     For i = 0 To UBound(t)<br />         If i <> 0 Then<br />             s = s & " "<br />         End If<br />         If (t(i) = -1) Or (t(i) >= 330 And t(i) <= 369) Then<br />             s = s & "(" & t(i) & " . " & "<图元名: " & LCase(Hex(v(i)(0))) & ">" & ")"<br />         ElseIf (t(i) >= 0 And t(i) <= 9) Or (t(i) >= 100 And t(i) <= 109) Or (t(i) >= 410 And t(i) <= 419) Then<br />             s = s & "(" & t(i) & " . " & """" & v(i) & """" & ")"<br />         ElseIf (t(i) >= 10 And t(i) <= 17) Or (t(i) >= 210 And t(i) <= 219) Then<br />             s = s & "(" & t(i) & " " & Format(v(i)(0), "0.0" & String(5 - IIf(Abs(Fix(v(i)(0))) = 0, 0, Len(Abs(Fix(v(i)(0))))), "#")) & " " & Format(v(i)(1), "0.0" & String(5 - IIf(Abs(Fix(v(i)(1))) = 0, 0, Len(Abs(Fix(v(i)(1))))), "#")) & " " & Format(v(i)(2), "0.0" & String(5 - IIf(Abs(Fix(v(i)(2))) = 0, 0, Len(Abs(Fix(v(i)(2))))), "#")) & ")"<br />         ElseIf (t(i) >= 38 And t(i) <= 59) Or (t(i) >= 140 And t(i) <= 149) Then<br />             s = s & "(" & t(i) & " . " & Format(v(i), "0.0" & String(5 - IIf(Abs(Fix(v(i))) = 0, 0, Len(Abs(Fix(v(i))))), "#")) & ")"<br />         Else<br />             s = s & "(" & t(i) & " . " & v(i) & ")"<br />         End If<br />     Next<br />     s = s & ")"<br />     Debug.Print s<br /> End Sub<br /> <br /> <br /> ' 获取对象组码-新版<br /> Sub testAcdbEntGet(ByVal ent As Variant)<br />     Dim rb As ResultBuffer<br />     Set rb = AcdbEntGet(ent)<br />     Dim v As Variant<br />     v = rb.AsArray()<br />     Dim s As String<br />     s = "("<br />     Dim i As Integer<br />     For i = 0 To UBound(v)<br />         Dim tv As TypedValue<br />         Set tv = v(i)<br />         If i <> 0 Then<br />             s = s & " "<br />         End If<br />         If (tv.TypeCode = -1) Or (tv.TypeCode >= 330 And tv.TypeCode <= 369) Then<br />             s = s & "(" & tv.TypeCode & " . " & "<图元名: " & LCase(Hex(tv.Value(0))) & ">" & ")"<br />         ElseIf (tv.TypeCode >= 0 And tv.TypeCode <= 9) Or (tv.TypeCode >= 100 And tv.TypeCode <= 109) Or (tv.TypeCode >= 410 And tv.TypeCode <= 419) Then<br />             s = s & "(" & tv.TypeCode & " . " & """" & tv.Value & """" & ")"<br />         ElseIf (tv.TypeCode >= 10 And tv.TypeCode <= 17) Or (tv.TypeCode >= 210 And tv.TypeCode <= 219) Then<br />             s = s & "(" & tv.TypeCode & " " & Format(tv.Value(0), "0.0" & String(5 - IIf(Abs(Fix(tv.Value(0))) = 0, 0, Len(Abs(Fix(tv.Value(0))))), "#")) & " " & Format(tv.Value(1), "0.0" & String(5 - IIf(Abs(Fix(tv.Value(1))) = 0, 0, Len(Abs(Fix(tv.Value(1))))), "#")) & " " & Format(tv.Value(2), "0.0" & String(5 - IIf(Abs(Fix(tv.Value(2))) = 0, 0, Len(Abs(Fix(tv.Value(2))))), "#")) & ")"<br />         ElseIf (tv.TypeCode >= 38 And tv.TypeCode <= 59) Or (tv.TypeCode >= 140 And tv.TypeCode <= 149) Then<br />             s = s & "(" & tv.TypeCode & " . " & Format(tv.Value, "0.0" & String(5 - IIf(Abs(Fix(tv.Value)) = 0, 0, Len(Abs(Fix(tv.Value)))), "#")) & ")"<br />         Else<br />             s = s & "(" & tv.TypeCode & " . " & tv.Value & ")"<br />         End If<br />     Next<br />     s = s & ")"<br />     Debug.Print s<br /> End Sub

在立即窗口输出：
5100
5100
((-1 . <图元名: fe95e118>) (0 . "LINE") (330 . <图元名: ffe8acf8>) (5 . "EB8B") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbLine") (10 0.0 0.0 0.0) (11 10.0 0.0 0.0) (210 0.0 0.0 1.0))

ARX的COM接口下载地址

efan2000

如果是先创建多个对象，那么可以通过acdbEntNext依次获取最后创建的对象。

1. ' 获取多个最后创建对象
   
2. Sub testAcdbEntNext()
   
3.     Dim r As Integer
   
4.     Dim v As Variant
   
5.     r = AcdbEntLast(v)
   
6.     Debug.Print r
   
7.     testAcdbEntMakeLine
   
8.     testAcdbEntMakeArc
   
9.     Dim tv As Variant
   
10.     If r = 5100 Then
    
11.         r = AcdbEntNext(v, tv)
    
12.     Else
    
13.         r = AcdbEntNext(Null, tv)
    
14.     End If
    
15.     Debug.Print r
    
16.     While r = 5100
    
17.         testAcdbEntGet tv
    
18.         v = tv
    
19.         r = AcdbEntNext(v, tv)
    
20.         Debug.Print r
    
21.     Wend
    
22. End Sub
    
23. 
    
24. ' 创建直线
    
25. Sub testAcdbEntMakeLine()
    
26.     Dim ct(0 To 2) As Integer
    
27.     Dim cv(0 To 2) As Variant
    
28.     ct(0) = 0
    
29.     cv(0) = "LINE"
    
30.     Dim pt1(0 To 2) As Double
    
31.     ct(1) = 10 ' 起点
    
32.     cv(1) = pt1
    
33.     Dim pt2(0 To 2) As Double
    
34.     pt2(0) = 10
    
35.     ct(2) = 11 ' 端点
    
36.     cv(2) = pt2
    
37.     Debug.Print AcdbEntMake(ct, cv)
    
38. End Sub
    
39. 
    
40. ' 创建圆弧
    
41. Sub testAcdbEntMakeArc()
    
42.     Dim ct(0 To 4) As Integer
    
43.     Dim cv(0 To 4) As Variant
    
44.     ct(0) = 0
    
45.     cv(0) = "ARC"
    
46.     Dim pt1(0 To 2) As Double
    
47.     ct(1) = 10 ' 圆心
    
48.     cv(1) = pt1
    
49.     ct(2) = 40 ' 半径
    
50.     cv(2) = 1
    
51.     ct(3) = 50 ' 起点角度
    
52.     cv(3) = 0
    
53.     ct(4) = 51 ' 端点角度
    
54.     cv(4) = 45
    
55.     Debug.Print AcdbEntMake(ct, cv)
    
56. End Sub
    
57. 
    
58. ' 获取对象组码
    
59. Sub testAcdbEntGet(ByVal ent As Variant)
    
60.     Dim t As Variant
    
61.     Dim v As Variant
    
62.     AcdbEntGet ent, t, v
    
63.     Dim s As String
    
64.     s = "("
    
65.     Dim i As Integer
    
66.     For i = 0 To UBound(t)
    
67.         If i <> 0 Then
    
68.             s = s & " "
    
69.         End If
    
70.         If (t(i) = -1) Or (t(i) >= 330 And t(i) <= 369) Then
    
71.             s = s & "(" & t(i) & " . " & "<图元名: " & LCase(Hex(v(i)(0))) & ">" & ")"
    
72.         ElseIf (t(i) >= 0 And t(i) <= 9) Or (t(i) >= 100 And t(i) <= 109) Or (t(i) >= 410 And t(i) <= 419) Then
    
73.             s = s & "(" & t(i) & " . " & """" & v(i) & """" & ")"
    
74.         ElseIf (t(i) >= 10 And t(i) <= 17) Or (t(i) >= 210 And t(i) <= 219) Then
    
75.             s = s & "(" & t(i) & " " & Format(v(i)(0), "0.0" & String(5 - IIf(Abs(Fix(v(i)(0))) = 0, 0, Len(Abs(Fix(v(i)(0))))), "#")) & " " & Format(v(i)(1), "0.0" & String(5 - IIf(Abs(Fix(v(i)(1))) = 0, 0, Len(Abs(Fix(v(i)(1))))), "#")) & " " & Format(v(i)(2), "0.0" & String(5 - IIf(Abs(Fix(v(i)(2))) = 0, 0, Len(Abs(Fix(v(i)(2))))), "#")) & ")"
    
76.         ElseIf (t(i) >= 38 And t(i) <= 59) Or (t(i) >= 140 And t(i) <= 149) Then
    
77.             s = s & "(" & t(i) & " . " & Format(v(i), "0.0" & String(5 - IIf(Abs(Fix(v(i))) = 0, 0, Len(Abs(Fix(v(i))))), "#")) & ")"
    
78.         Else
    
79.             s = s & "(" & t(i) & " . " & v(i) & ")"
    
80.         End If
    
81.     Next
    
82.     s = s & ")"
    
83.     Debug.Print s
    
84. End Sub

' 获取多个最后创建对象<br /> Sub testAcdbEntNext()<br />     Dim r As Integer<br />     Dim v As Variant<br />     r = AcdbEntLast(v)<br />     Debug.Print r<br />     testAcdbEntMakeLine<br />     testAcdbEntMakeArc<br />     Dim tv As Variant<br />     If r = 5100 Then<br />         r = AcdbEntNext(v, tv)<br />     Else<br />         r = AcdbEntNext(Null, tv)<br />     End If<br />     Debug.Print r<br />     While r = 5100<br />         testAcdbEntGet tv<br />         v = tv<br />         r = AcdbEntNext(v, tv)<br />         Debug.Print r<br />     Wend<br /> End Sub<br /> <br /> ' 创建直线<br /> Sub testAcdbEntMakeLine()<br />     Dim ct(0 To 2) As Integer<br />     Dim cv(0 To 2) As Variant<br />     ct(0) = 0<br />     cv(0) = "LINE"<br />     Dim pt1(0 To 2) As Double<br />     ct(1) = 10 ' 起点<br />     cv(1) = pt1<br />     Dim pt2(0 To 2) As Double<br />     pt2(0) = 10<br />     ct(2) = 11 ' 端点<br />     cv(2) = pt2<br />     Debug.Print AcdbEntMake(ct, cv)<br /> End Sub<br /> <br /> ' 创建圆弧<br /> Sub testAcdbEntMakeArc()<br />     Dim ct(0 To 4) As Integer<br />     Dim cv(0 To 4) As Variant<br />     ct(0) = 0<br />     cv(0) = "ARC"<br />     Dim pt1(0 To 2) As Double<br />     ct(1) = 10 ' 圆心<br />     cv(1) = pt1<br />     ct(2) = 40 ' 半径<br />     cv(2) = 1<br />     ct(3) = 50 ' 起点角度<br />     cv(3) = 0<br />     ct(4) = 51 ' 端点角度<br />     cv(4) = 45<br />     Debug.Print AcdbEntMake(ct, cv)<br /> End Sub<br /> <br /> ' 获取对象组码<br /> Sub testAcdbEntGet(ByVal ent As Variant)<br />     Dim t As Variant<br />     Dim v As Variant<br />     AcdbEntGet ent, t, v<br />     Dim s As String<br />     s = "("<br />     Dim i As Integer<br />     For i = 0 To UBound(t)<br />         If i <> 0 Then<br />             s = s & " "<br />         End If<br />         If (t(i) = -1) Or (t(i) >= 330 And t(i) <= 369) Then<br />             s = s & "(" & t(i) & " . " & "<图元名: " & LCase(Hex(v(i)(0))) & ">" & ")"<br />         ElseIf (t(i) >= 0 And t(i) <= 9) Or (t(i) >= 100 And t(i) <= 109) Or (t(i) >= 410 And t(i) <= 419) Then<br />             s = s & "(" & t(i) & " . " & """" & v(i) & """" & ")"<br />         ElseIf (t(i) >= 10 And t(i) <= 17) Or (t(i) >= 210 And t(i) <= 219) Then<br />             s = s & "(" & t(i) & " " & Format(v(i)(0), "0.0" & String(5 - IIf(Abs(Fix(v(i)(0))) = 0, 0, Len(Abs(Fix(v(i)(0))))), "#")) & " " & Format(v(i)(1), "0.0" & String(5 - IIf(Abs(Fix(v(i)(1))) = 0, 0, Len(Abs(Fix(v(i)(1))))), "#")) & " " & Format(v(i)(2), "0.0" & String(5 - IIf(Abs(Fix(v(i)(2))) = 0, 0, Len(Abs(Fix(v(i)(2))))), "#")) & ")"<br />         ElseIf (t(i) >= 38 And t(i) <= 59) Or (t(i) >= 140 And t(i) <= 149) Then<br />             s = s & "(" & t(i) & " . " & Format(v(i), "0.0" & String(5 - IIf(Abs(Fix(v(i))) = 0, 0, Len(Abs(Fix(v(i))))), "#")) & ")"<br />         Else<br />             s = s & "(" & t(i) & " . " & v(i) & ")"<br />         End If<br />     Next<br />     s = s & ")"<br />     Debug.Print s<br /> End Sub

在立即窗口输出：
-5001
5100
5100
5100
((-1 . <图元名: ffe8c128>) (0 . "LINE") (330 . <图元名: ffe8acf8>) (5 . "12D") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbLine") (10 0.0 0.0 0.0) (11 10.0 0.0 0.0) (210 0.0 0.0 1.0))
5100
((-1 . <图元名: ffe8c130>) (0 . "ARC") (330 . <图元名: ffe8acf8>) (5 . "12E") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbCircle") (10 0.0 0.0 0.0) (40 . 1.0) (210 0.0 0.0 1.0) (100 . "AcDbArc") (50 . 0.0) (51 . 1.0177))
-5001

434939575

高级，看不懂。想学习下@