哪里错了？文字怎么加入块中

晶晶静静

如要想把文字说明和对应的直线封装到一起组成一个块 但是文字总是加不进去~~~郁闷，帮忙看看程序哪里有问题？一直抱错~~ Dim ssetObj As AcadSelectionSet
Dim getbiaohao As String
Dim FilterType(5) As Integer
Dim FilterData(5) As Variant
Dim adText As String
Dim adhight As Double
Dim insertionPnt(0 To 2) As Double
Dim blockObj As AcadBlock
Dim temp As Variant
Dim element As AcadEntity
Dim obtext As AcadText

insertionPnt(0) = 0
insertionPnt(1) = 0
insertionPnt(2) = 0


Set ssetObj = ThisDrawing.SelectionSets.Add("ssetObj")

FilterType(0) = -4
FilterData(0) = "<or"
FilterType(1) = 0
FilterData(1) = "Text"
FilterType(2) = 8
FilterData(2) = "0"
FilterType(4) = 0
FilterData(4) = "Polyline"
FilterType(5) = -4
FilterData(5) = "or>"

ssetObj.SelectOnScreen FilterType, FilterData
For Each element In ssetObj
If element.ObjectName = "AcDbText" Then
temp = element.TextString
adText = temp
temp = element.Height
adhight = temp
Set obtext = blockObj.AddText(adText, insertionPnt, adhight)
ElseIf element.ObjectName = "AcDbPolyline" Then
temp = element.Coordinates
blockObj.AddPolyline (temp)
End If
Next

mccad

你的块在哪里？

晶晶静静

ssetObj.SelectOnScreen FilterType, FilterData
Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "CircleBlock")

For Each element In ssetObj
If element.ObjectName = "AcDbText" Then
temp = element.TextString
adText = temp
temp = element.Height
adhight = temp
Set obtext = blockObj.AddText(adText, insertionPnt, adhight)
ElseIf element.ObjectName = "AcDbPolyline" Then
temp = element.Coordinates
blockObj.AddPolyline (temp)
End If
Next 少给了一句，不好意思，删多余对话框的时候，不小心删掉了

雪山飞狐_lzh

直接用CopyObjects方法试试