ARX的COM函数库之实体篇(acdbEntGet)
本帖最后由 efan2000 于 2014-6-19 20:45 编辑通过acdbEntMake可以创建对象，创建之后可以通过acdbEntLast获取最后创建的对象，再通过acdbEntGet可以查询对象的信息。
' 创建直线
Sub testAcdbEntMakeLine()
Dim ct(0 To 2) As Integer
Dim cv(0 To 2) As Variant
ct(0) = 0
cv(0) = "LINE"
Dim pt1(0 To 2) As Double
ct(1) = 10 ' 起点
cv(1) = pt1
Dim pt2(0 To 2) As Double
pt2(0) = 10
ct(2) = 11 ' 端点
cv(2) = pt2
Debug.Print AcdbEntMake(ct, cv)
testAcdbEntLast
End Sub
' 创建直线-新版
Sub testAcdbEntMakeLine()
Dim ent As ResultBuffer
Set ent = New ResultBuffer
ent.AddTypedValue 0, "LINE"
Dim pt1(0 To 2) As Double
ent.AddTypedValue 10, pt1 ' 起点
Dim pt2(0 To 2) As Double
pt2(0) = 10
ent.AddTypedValue 11, pt2 ' 端点
Debug.Print AcdbEntMake(ent)
End Sub
' 获取最后创建对象
Sub testAcdbEntLast()
Dim v As Variant
Debug.Print AcdbEntLast(v)
testAcdbEntGet v
End Sub
' 获取对象组码
Sub testAcdbEntGet(ByVal ent As Variant)
Dim t As Variant
Dim v As Variant
AcdbEntGet ent, t, v
Dim s As String
s = "("
Dim i As Integer
For i = 0 To UBound(t)
If i <> 0 Then
s = s & " "
End If
If (t(i) = -1) Or (t(i) >= 330 And t(i) <= 369) Then
s = s & "(" & t(i) & " . " & "<图元名: " & LCase(Hex(v(i)(0))) & ">" & ")"
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
s = s & "(" & t(i) & " . " & """" & v(i) & """" & ")"
ElseIf (t(i) >= 10 And t(i) <= 17) Or (t(i) >= 210 And t(i) <= 219) Then
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))))), "#")) & ")"
ElseIf (t(i) >= 38 And t(i) <= 59) Or (t(i) >= 140 And t(i) <= 149) Then
s = s & "(" & t(i) & " . " & Format(v(i), "0.0" & String(5 - IIf(Abs(Fix(v(i))) = 0, 0, Len(Abs(Fix(v(i))))), "#")) & ")"
Else
s = s & "(" & t(i) & " . " & v(i) & ")"
End If
Next
s = s & ")"
Debug.Print s
End Sub
' 获取对象组码-新版
Sub testAcdbEntGet(ByVal ent As Variant)
Dim rb As ResultBuffer
Set rb = AcdbEntGet(ent)
Dim v As Variant
v = rb.AsArray()
Dim s As String
s = "("
Dim i As Integer
For i = 0 To UBound(v)
Dim tv As TypedValue
Set tv = v(i)
If i <> 0 Then
s = s & " "
End If
If (tv.TypeCode = -1) Or (tv.TypeCode >= 330 And tv.TypeCode <= 369) Then
s = s & "(" & tv.TypeCode & " . " & "<图元名: " & LCase(Hex(tv.Value(0))) & ">" & ")"
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
s = s & "(" & tv.TypeCode & " . " & """" & tv.Value & """" & ")"
ElseIf (tv.TypeCode >= 10 And tv.TypeCode <= 17) Or (tv.TypeCode >= 210 And tv.TypeCode <= 219) Then
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))))), "#")) & ")"
ElseIf (tv.TypeCode >= 38 And tv.TypeCode <= 59) Or (tv.TypeCode >= 140 And tv.TypeCode <= 149) Then
s = s & "(" & tv.TypeCode & " . " & Format(tv.Value, "0.0" & String(5 - IIf(Abs(Fix(tv.Value)) = 0, 0, Len(Abs(Fix(tv.Value)))), "#")) & ")"
Else
s = s & "(" & tv.TypeCode & " . " & tv.Value & ")"
End If
Next
s = s & ")"
Debug.Print s
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 于 2014-4-21 13:55 编辑
如果是先创建多个对象，那么可以通过acdbEntNext依次获取最后创建的对象。
' 获取多个最后创建对象
Sub testAcdbEntNext()
Dim r As Integer
Dim v As Variant
r = AcdbEntLast(v)
Debug.Print r
testAcdbEntMakeLine
testAcdbEntMakeArc
Dim tv As Variant
If r = 5100 Then
r = AcdbEntNext(v, tv)
Else
r = AcdbEntNext(Null, tv)
End If
Debug.Print r
While r = 5100
testAcdbEntGet tv
v = tv
r = AcdbEntNext(v, tv)
Debug.Print r
Wend
End Sub
' 创建直线
Sub testAcdbEntMakeLine()
Dim ct(0 To 2) As Integer
Dim cv(0 To 2) As Variant
ct(0) = 0
cv(0) = "LINE"
Dim pt1(0 To 2) As Double
ct(1) = 10 ' 起点
cv(1) = pt1
Dim pt2(0 To 2) As Double
pt2(0) = 10
ct(2) = 11 ' 端点
cv(2) = pt2
Debug.Print AcdbEntMake(ct, cv)
End Sub
' 创建圆弧
Sub testAcdbEntMakeArc()
Dim ct(0 To 4) As Integer
Dim cv(0 To 4) As Variant
ct(0) = 0
cv(0) = "ARC"
Dim pt1(0 To 2) As Double
ct(1) = 10 ' 圆心
cv(1) = pt1
ct(2) = 40 ' 半径
cv(2) = 1
ct(3) = 50 ' 起点角度
cv(3) = 0
ct(4) = 51 ' 端点角度
cv(4) = 45
Debug.Print AcdbEntMake(ct, cv)
End Sub
' 获取对象组码
Sub testAcdbEntGet(ByVal ent As Variant)
Dim t As Variant
Dim v As Variant
AcdbEntGet ent, t, v
Dim s As String
s = "("
Dim i As Integer
For i = 0 To UBound(t)
If i <> 0 Then
s = s & " "
End If
If (t(i) = -1) Or (t(i) >= 330 And t(i) <= 369) Then
s = s & "(" & t(i) & " . " & "<图元名: " & LCase(Hex(v(i)(0))) & ">" & ")"
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
s = s & "(" & t(i) & " . " & """" & v(i) & """" & ")"
ElseIf (t(i) >= 10 And t(i) <= 17) Or (t(i) >= 210 And t(i) <= 219) Then
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))))), "#")) & ")"
ElseIf (t(i) >= 38 And t(i) <= 59) Or (t(i) >= 140 And t(i) <= 149) Then
s = s & "(" & t(i) & " . " & Format(v(i), "0.0" & String(5 - IIf(Abs(Fix(v(i))) = 0, 0, Len(Abs(Fix(v(i))))), "#")) & ")"
Else
s = s & "(" & t(i) & " . " & v(i) & ")"
End If
Next
s = s & ")"
Debug.Print s
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 高级，看不懂。想学习下@
页:
[1]