[求助]怎样把已有的图形加入自己新建的块中？

莫名

是内部块还是外部块？

mccad

可使用.CopyObjects方法。

mccad

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=13747&replyID=62826&skin=1

czbming

针对你的程序改了一下.如下: Sub join() Dim ss As AcadSelectionSet
Dim po(0 To 2) As Double

On Error Resume Next

po(0) = 0
po(1) = 0
po(2) = 0

'ThisDrawing.Blocks.Item("ok").Delete
Dim bk As AcadBlock

Set bk = ThisDrawing.Blocks.Add(po, "tempb")

Set ss = ThisDrawing.SelectionSets.item("ssss")
'------------------------------------------------
If Err Then
Err.Clear
Set ss = ThisDrawing.SelectionSets.Add("ssss")
End If
'------------------------------------------------

Dim ftype(0) As Integer
Dim fdata(0) As Variant
Dim i As Long

ftype(0) = 8
fdata(0) = "layer"
ss.Select acSelectionSetAll, , , ftype, fdata '过滤
ReDim retVal(0 To ss.count - 1) As AcadEntity
For i = 0 To ss.count - 1
Set retVal(i) = ss.item(i)
Next

''------------------------------------------------过滤对象
'Dim retVal(), Ent As AcadEntity
'
'
'Dim i As Integer
'i = 0
'
' ReDim retVal(0 To ss.count - 1)
'
' For Each Ent In ss
'
' If (Ent.layer = "layer") Then
' Set retVal(i) = Ent
' i = i + 1
' End If
'
' Next
' ReDim Preserve retVal(0 To i - 1)

'------------------------------------------------

ThisDrawing.CopyObjects retVal, bk ' 在这里出问题了
Erase retVal
End Sub

mccad

关键是在定义数组上，这样写就没有问题：
Dim retVal() As AcadEntity, Ent As AcadEntity
注意：一般不要这样写：
Dim retVal() , Ent As AcadEntity
这样写的话，第一个变量会被定义成Variant，所以会造成CopyObjects时传递的不是图元数组。