[求助]：如何用VBA在两个图形间拷贝对象？

烛光

如题！谢谢！

efan2000

可以用ThisDrawing.CopyObjects方法。使用方法如下：
语法
RetVal = object.CopyObjects(Objects[, Owner][, IDPairs])
Object        Document对象
Objects        要拷贝的对象集合
Owner        存放拷贝对象的地方，可以是Block或Document对象

EnjoyVba

给你段代码：

2. 
   
3. [FONT=courier new]
   
4. Sub test()
   
5. 
   
6. Dim objects() As Object
   
7. Dim ss As AcadSelectionSet
   
8. Dim i As Integer
   
9. Dim obj As Object
   
10. Dim owner As AcadModelSpace
    
11. 
    
12. i = 0
    
13. 'Create a Selection set of entities.
    
14. Set ss = ThisDrawing.SelectionSets.Add("TTT")
    
15. ss.SelectOnScreen
    
16. ReDim objects(ss.Count - 1)
    
17. 
    
18. 'Populate the objects collection.
    
19. For Each obj In ss
    
20.    Set objects(i) = obj
    
21.    i = i + 1
    
22. Next obj
    
23. 
    
24. 'Obtain a pointer to the target document.
    
25. Set owner = Application.Documents.Item(0).ModelSpace
    
26. ThisDrawing.CopyObjects objects, owner
    
27. ss.Delete
    
28. Application.Documents.Item(0).Activate
    
29. 
    
30. End Sub
    
31. [/FONT]

<br /> [FONT=courier new]<br /> Sub test()<br /> <br /> Dim objects() As Object<br /> Dim ss As AcadSelectionSet<br /> Dim i As Integer<br /> Dim obj As Object<br /> Dim owner As AcadModelSpace<br /> <br /> i = 0<br /> 'Create a Selection set of entities.<br /> Set ss = ThisDrawing.SelectionSets.Add("TTT")<br /> ss.SelectOnScreen<br /> ReDim objects(ss.Count - 1)<br /> <br /> 'Populate the objects collection.<br /> For Each obj In ss<br />    Set objects(i) = obj<br />    i = i + 1<br /> Next obj<br /> <br /> 'Obtain a pointer to the target document.<br /> Set owner = Application.Documents.Item(0).ModelSpace<br /> ThisDrawing.CopyObjects objects, owner<br /> ss.Delete<br /> Application.Documents.Item(0).Activate<br /> <br /> End Sub<br /> [/FONT]