[VBA函数]：如何在AUTOCAD的VBA中把块炸开？

foxzz

如题
因为需要转换到其它格式。

多谢大侠指教
谢谢

秋枫

有explode方法的。

efan2000

附上例子。

2. 
   
3.   [FONT=courier new]
   
4. Sub Ch10_ExplodingABlock()
   
5.     ' 定义块
   
6.     Dim blockObj As AcadBlock
   
7.     Dim insertionPnt(0 To 2) As Double
   
8.     insertionPnt(0) = 0
   
9.     insertionPnt(1) = 0
   
10.     insertionPnt(2) = 0
    
11.     Set blockObj = ThisDrawing.Blocks.Add _
    
12.                      (insertionPnt, "CircleBlock")
    
13.    
    
14.     ' 添加圆到块中
    
15.     Dim circleObj As AcadCircle
    
16.     Dim center(0 To 2) As Double
    
17.     Dim radius As Double
    
18.     center(0) = 0
    
19.     center(1) = 0
    
20.     center(2) = 0
    
21.     radius = 1
    
22.     Set circleObj = blockObj.AddCircle(center, radius)
    
23.    
    
24.     ' 插入块
    
25.     Dim blockRefObj As AcadBlockReference
    
26.     insertionPnt(0) = 2
    
27.     insertionPnt(1) = 2
    
28.     insertionPnt(2) = 0
    
29.     Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock _
    
30.                (insertionPnt, "CircleBlock", 1#, 1#, 1#, 0)
    
31.     MsgBox "The circle belongs to " & blockRefObj.ObjectName
    
32.    
    
33.     ' 炸开块引用
    
34.     Dim explodedObjects As Variant
    
35.     explodedObjects = blockRefObj.Explode
    
36.    
    
37.     ' 枚举炸开的实体对象
    
38.     Dim I As Integer
    
39.     For I = 0 To UBound(explodedObjects)
    
40.         explodedObjects(I).Color = acRed
    
41.         explodedObjects(I).Update
    
42.         MsgBox "Exploded Object " & I & ": " _
    
43.                             & explodedObjects(I).ObjectName
    
44.         explodedObjects(I).Color = acByLayer
    
45.         explodedObjects(I).Update
    
46.     Next
    
47. End Sub
    
48. 
    
49.   [/FONT]
    

<br />   [FONT=courier new]<br /> Sub Ch10_ExplodingABlock()<br />     ' 定义块<br />     Dim blockObj As AcadBlock<br />     Dim insertionPnt(0 To 2) As Double<br />     insertionPnt(0) = 0<br />     insertionPnt(1) = 0<br />     insertionPnt(2) = 0<br />     Set blockObj = ThisDrawing.Blocks.Add _<br />                      (insertionPnt, "CircleBlock")<br />     <br />     ' 添加圆到块中<br />     Dim circleObj As AcadCircle<br />     Dim center(0 To 2) As Double<br />     Dim radius As Double<br />     center(0) = 0<br />     center(1) = 0<br />     center(2) = 0<br />     radius = 1<br />     Set circleObj = blockObj.AddCircle(center, radius)<br />    <br />     ' 插入块<br />     Dim blockRefObj As AcadBlockReference<br />     insertionPnt(0) = 2<br />     insertionPnt(1) = 2<br />     insertionPnt(2) = 0<br />     Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock _<br />                (insertionPnt, "CircleBlock", 1#, 1#, 1#, 0)<br />     MsgBox "The circle belongs to " & blockRefObj.ObjectName<br />     <br />     ' 炸开块引用<br />     Dim explodedObjects As Variant<br />     explodedObjects = blockRefObj.Explode<br />     <br />     ' 枚举炸开的实体对象<br />     Dim I As Integer<br />     For I = 0 To UBound(explodedObjects)<br />         explodedObjects(I).Color = acRed<br />         explodedObjects(I).Update<br />         MsgBox "Exploded Object " & I & ": " _<br />                             & explodedObjects(I).ObjectName<br />         explodedObjects(I).Color = acByLayer<br />         explodedObjects(I).Update<br />     Next<br /> End Sub<br /> <br />   [/FONT]<br />

foxzz

多谢。
已经解决。