在网上找了找,原来块本身就是一个集合,可以用for ... each来取得子图元,以下是源程序: ‘没有加注示,如果不明白可以查CAD的帮助 Option Explicit Sub Example_Select() On Error Resume Next Dim ssetObj As AcadSelectionSet Set ssetObj = ThisDrawing.SelectionSets.Add("sset") If Err Then Err.Clear Set ssetObj = ThisDrawing.SelectionSets.Item("sset") End If ssetObj.Clear Dim mode As Integer Dim corner1(0 To 2) As Double Dim corner2(0 To 2) As Double Dim gpCode(0) As Integer Dim dataValue(0) As Variant gpCode(0) = 0 dataValue(0) = "insert" Dim groupCode As Variant, dataCode As Variant groupCode = gpCode dataCode = dataValue ssetObj.Select acSelectionSetAll, , , groupCode, dataCode Dim i As Integer Dim blkobj As AcadBlock, blkn As String For i = 0 To ssetObj.Count - 1 Set blkobj = ThisDrawing.Blocks(ssetObj.Item(i).Name) blkn = blkobj.Name Debug.Print "block", i, "'sname="; blkn Ltoc blkobj Next ThisDrawing.Regen acActiveViewport End Sub Sub Ltoc(blk As AcadBlock) Dim Sube As AcadEntity, p1 As Variant, p2 As Variant, pcen(2) As Double, rad As Double For Each Sube In blk Debug.Print Sube.ObjectName If Sube.ObjectName = "AcDbBlockReference" Then Ltoc ThisDrawing.Blocks(Sube.Name) ElseIf Sube.ObjectName = "AcDbLine" Then p1 = Sube.StartPoint p2 = Sube.EndPoint pcen(0) = (p1(0) + p2(0)) / 2 pcen(1) = (p1(1) + p2(1)) / 2 pcen(2) = (p1(2) + p2(2)) / 2 rad = Sube.Length / 2 Sube.Delete blk.AddCircle pcen, rad End If Next End Sub
|