- UID
- 5244
- 积分
- 1648
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2002-5-18
- 最后登录
- 1970-1-1
|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
在VBA中可以用CopyObjects方法将对象拷贝到块中。
运用此方法可以进行块的重定义等。
函数原型:RetVal = object.CopyObjects(Objects[, Owner][, IDPairs])
Object:文档对象
Objects:要拷贝的对象集合
Owner:拷贝生成的新对象的宿主对象,可以是块或者另一个文档。
程序示例如下:
Sub Text()
' 创建块
Dim blockObj As AcadBlock
Dim insertionPnt(0 To 2) As Double
insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "CircleBlock")
' 在模型空间添加圆
Dim circleObj As AcadCircle
Dim center(0 To 2) As Double
Dim radius As Double
center(0) = 0: center(1) = 0: center(2) = 0
radius = 1
Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
' 创建对象集合
Dim objCollection(0 To 0) As Object
Set objCollection(0) = circleObj
' 拷贝对象到块中,并返回新拷贝的对象
Dim retObjects As Variant
retObjects = ThisDrawing.CopyObjects(objCollection, blockObj)
' 插入块到模型空间
Dim blockRefObj As AcadBlockReference
insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "CircleBlock", 1#, 1#, 1#, 0)
ZoomAll
End Sub |
|