入门级问题_如何用VBA的方法将图形中一些实体转化为内部块

my_computer

如题

雪山飞狐_lzh

Copyobjects

my_computer

copyobjects是用来复制实体用的.

我是想将图形中的一些实体(例如我们已经将他们放在一个选择集中了),做成Block.这个功能就像block命令,选择一些实体,并将他们块.

mccad

这是添加对象到图块中的函数，改造一下就可以变成选择集变图块了：

2. Public Sub AddObjectsToBlock(blkRef As AcadBlockReference, _
3.             entArray() As AcadEntity,Optional delObj As Boolean = True)
4.     Dim blkDef As AcadBlock, origin(0 To 2) As Double, i As Long
5.    
6.     origin(0) = 0: origin(1) = 0: origin(2) = 0
7.    
8.     Set blkDef = ThisDrawing.Blocks(blkRef.Name)
9.    
10.     For i = LBound(entArray) To UBound(entArray)
11.         entArray(i).Move blkRef.InsertionPoint, origin
12.     Next
13.    
14.     ThisDrawing.CopyObjects entArray, blkDef
15.    
16.     If delObj Then
17.         For i = LBound(entArray) To UBound(entArray)
18.             entArray(i).Delete
19.         Next
20.     End If
21. End Sub

Public Sub AddObjectsToBlock(blkRef As AcadBlockReference, _             entArray() As AcadEntity,Optional delObj As Boolean = True)     Dim blkDef As AcadBlock, origin(0 To 2) As Double, i As Long         origin(0) = 0: origin(1) = 0: origin(2) = 0         Set blkDef = ThisDrawing.Blocks(blkRef.Name)         For i = LBound(entArray) To UBound(entArray)         entArray(i).Move blkRef.InsertionPoint, origin     Next         ThisDrawing.CopyObjects entArray, blkDef         If delObj Then         For i = LBound(entArray) To UBound(entArray)             entArray(i).Delete         Next     End If End Sub

my_computer

好程序.