|
|
Private Sub test()
On Error Resume Next
Dim blockObj As AcadBlock
Dim insertionPnt(0 To 2) As Double
Dim circleObj As AcadCircle
Dim center(0 To 2) As Double
insertionPnt(0) = 0.0# : insertionPnt(1) = 0.0# : insertionPnt(2) = 0.0#
blockObj = acadapp.ActiveDocument.Blocks.Add(insertionPnt, "CircleBlock") ' 创建块
center(0) = 0 : center(1) = 0 : center(2) = 0
circleObj = acadapp.ActiveDocument.ModelSpace.AddCircle(center, 50) ' 在模型空间添加圆
Dim objCollection(0 To 0) As Object
objCollection(0) = circleObj ' 创建对象集合
Dim retObjects As Object
retObjects = acadapp.ActiveDocument.CopyObjects(objCollection, blockObj) ' 拷贝对象到块中，并返回新拷贝的对象
circleObj.Delete()
Dim blockRefObj As AcadBlockReference
insertionPnt(0) = 2.0# : insertionPnt(1) = 2.0# : insertionPnt(2) = 0
blockRefObj = acadapp.ActiveDocument.ModelSpace.InsertBlock(insertionPnt, "CircleBlock", 1.0#, 1.0#, 1.0#, 0) ' 插入块到模型空间
End Sub
retObjects = acadapp.ActiveDocument.CopyObjects(objCollection, blockObj)这一步执行未能成功，原因是什么？？？ |
|
置顶卡
