怎么把生成的对象添加到块中

qwh923820 · 发表于 2018-7-9 11:39:00

怎么把生成的对象添加到块中？为什么这样会出错，该怎么改？
dim x As Object,ww As AcadBlock
Set ww = ThisDrawing.Blocks.Add(pt, blockname1)
Set x = ThisDrawing.ModelSpace.AddLightWeightPolyline(A)
ThisDrawing.CopyObjects x, ww 出错

zzyong00 · 发表于 2018-7-9 21:24:00

语法
RetVal = object.CopyObjects(Objects[, Owner][, IDPairs])
Object
Database, Document
使用该方法的对象。
Objects
Variant[变体] (对象数组); 仅用于输入
要复制的源对象数组。所有对象必须有相同的所有者，而且该所有者必须属于调用该方法的数据库或文档。
Owner
Variant[变体] (单个对象); 仅用于输入; 可选项
对象要复制到的新的所有者。如果没有指定所有者，对象将被创建到与 Objects 数组中的对象相同的所有者中。
IDPairs
Variant[变体] (IDPair 对象数组); 输入输出; 可选项
复制及传送过程所发生的信息。
Input: 一个空变体。
Output: 一个 IDPair 对象数组。
RetVal
Variant[变体] (对象数组)
新创建的复制对象数组。只有源对象才在该数组中返回。有关 CopyObjects 操作过程会发生的更多信息，或将同时被复制的属于源对象的对象列表，可参考 IDPairs 数组。
说明
要复制对象到其它打开的图形中，可设置 Owner 参数为其它图形的模型空间。
在 CopyObjects 操作期间，被 Objects 参数中的源对象拥有或引用的对象也将被复制。
注意当同时遍历集合时不能执行该方法。在遍历过程中将打开一个只读操作的工作空间，而该方法试图执行可读写操作。必须在完成遍历后才调用该方法。

dong20030432 · 发表于 2018-7-10 09:00:00

下面是一段VB代码，请参考！
Dim NoNamBlo As Object
Dim BasePnt As Variant
Dim Ent() As Object
Dim ownName As String
Dim ret As Variant
On Error Resume Next
Set sset = acadapp.ActiveDocument.SelectionSets.Item("ss1")
sset.Delete
Set sset = acadapp.ActiveDocument.SelectionSets.Add("ss1")
AppActivate acadapp.Caption
acadapp.ActiveDocument.Utility.Prompt "请选择要建立块的对象"
sset.SelectOnScreen
If CheckKey(VK_ESCAPE) = True Then
Exit Sub
End If
BasePnt = acadapp.ActiveDocument.Utility.GetPoint(, "请拾取块基点")
If CheckKey(VK_ESCAPE) = True Then
Exit Sub
End If
Set NoNamBlo = acadapp.ActiveDocument.Blocks.Add(BasePnt, "*u")
ownName = NoNamBlo.Name
ReDim Ent(sset.Count - 1)
For i = 0 To sset.Count - 1
Set Ent(i) = sset.Item(i)
Next
acadapp.ActiveDocument.CopyObjects Ent, NoNamBlo
sset.Erase
sset.Delete
acadapp.ActiveDocument.ModelSpace.InsertBlock BasePnt, ownName, 1, 1, 1, 0
acadapp.ActiveDocument.Utility.Prompt "块建立完成！块名称是：" & ownName & vbLf