VBA中，如何炸开Mline

wjfling

如何炸开Mlind 为 line
object.Explode  不支持呀

zeng29

确实如此,希望以的版本能提供这样的方法;

2. Sub ExampleExplodeMline()
   
3.     Dim ssetObj As AcadSelectionSet
   
4.     Dim i As Integer
   
5.     Dim explodedObjects As Variant
   
6.    
   
7.     Dim OldCount As Long, NewCount As Long
   
8.    
   
9.     Set ssetObj = ThisDrawing.PickfirstSelectionSet
   
10.     ssetObj.Clear
    
11.     ssetObj.SelectOnScreen
    
12.     If ssetObj.Count <= 0 Then Exit Sub
    
13.     On Error Resume Next
    
14.     explodedObjects = ssetObj(0).Explode
    
15.     If Err Then
    
16.         Err.Clear
    
17.         OldCount = ThisDrawing.ModelSpace.Count
    
18.         Debug.Print "炸开前的实体:"
    
19.         For i = 0 To ThisDrawing.ModelSpace.Count
    
20.             Debug.Print i & ":" & ThisDrawing.ModelSpace(i).ObjectName
    
21.         Next i
    
22.         ThisDrawing.SendCommand "_explode (handent " & Chr(34) & ssetObj(0).Handle & Chr(34) & ") " & vbCr
    
23.         If OldCount <> ThisDrawing.ModelSpace.Count Then
    
24.             Debug.Print "被炸开形成的实体:"
    
25.             For i = OldCount - 1 To ThisDrawing.ModelSpace.Count
    
26.                 Debug.Print i & ":" & ThisDrawing.ModelSpace(i).ObjectName
    
27.             Next i
    
28.         End If
    
29.         Debug.Print "炸开后的实体:"
    
30.         For i = 0 To ThisDrawing.ModelSpace.Count
    
31.             Debug.Print i & ":" & ThisDrawing.ModelSpace(i).ObjectName
    
32.         Next i
    
33.         Exit Sub
    
34.     End If
    
35.     On Error GoTo 0
    
36.     ' Loop through the exploded objects
    
37.    
    
38.     For i = 0 To UBound(explodedObjects)
    
39.         explodedObjects(i).Update
    
40.         MsgBox "Exploded Object " & i & ": " & explodedObjects(i).ObjectName, , "Explode Example"
    
41.         explodedObjects(i).color = acByLayer
    
42.         explodedObjects(i).Update
    
43.     Next
    
44.    
    
45. End Sub

Sub ExampleExplodeMline()<br />     Dim ssetObj As AcadSelectionSet<br />     Dim i As Integer<br />     Dim explodedObjects As Variant<br />     <br />     Dim OldCount As Long, NewCount As Long<br />     <br />     Set ssetObj = ThisDrawing.PickfirstSelectionSet<br />     ssetObj.Clear<br />     ssetObj.SelectOnScreen<br />     If ssetObj.Count <= 0 Then Exit Sub<br />     On Error Resume Next<br />     explodedObjects = ssetObj(0).Explode<br />     If Err Then<br />         Err.Clear<br />         OldCount = ThisDrawing.ModelSpace.Count<br />         Debug.Print "炸开前的实体:"<br />         For i = 0 To ThisDrawing.ModelSpace.Count<br />             Debug.Print i & ":" & ThisDrawing.ModelSpace(i).ObjectName<br />         Next i<br />         ThisDrawing.SendCommand "_explode (handent " & Chr(34) & ssetObj(0).Handle & Chr(34) & ") " & vbCr<br />         If OldCount <> ThisDrawing.ModelSpace.Count Then<br />             Debug.Print "被炸开形成的实体:"<br />             For i = OldCount - 1 To ThisDrawing.ModelSpace.Count<br />                 Debug.Print i & ":" & ThisDrawing.ModelSpace(i).ObjectName<br />             Next i<br />         End If<br />         Debug.Print "炸开后的实体:"<br />         For i = 0 To ThisDrawing.ModelSpace.Count<br />             Debug.Print i & ":" & ThisDrawing.ModelSpace(i).ObjectName<br />         Next i<br />         Exit Sub<br />     End If<br />     On Error GoTo 0<br />     ' Loop through the exploded objects<br />     <br />     For i = 0 To UBound(explodedObjects)<br />         explodedObjects(i).Update<br />         MsgBox "Exploded Object " & i & ": " & explodedObjects(i).ObjectName, , "Explode Example"<br />         explodedObjects(i).color = acByLayer<br />         explodedObjects(i).Update<br />     Next<br />     <br /> End Sub

mccad

ActiveX(VBA)对多线的支持太少了，只能通过SendCommand方法来打散。