|
|
发表于 2011-10-26 11:59:00
|
显示全部楼层
我的编程思路大概是这样：先创建一个选择集程序，设定范围，设定完之后在进行插入块；选择集的程序做好了
Sub Select_Polygon()
Dim SSet As AcadSelectionSet
Dim SSetObj As Object
On Error Resume Next
Dim fType(0 To 1) As Integer
Dim fData(0 To 1) As Variant
If Not IsNull(ThisDrawing.SelectionSets.Item("BlockCount")) Then
Set SSet = ThisDrawing.SelectionSets.Item("BlockCount")
SSet.Delete
End If
Set SSet = ThisDrawing.SelectionSets.Add("BlockCount")
fType(0) = 0: fData(0) = "Insert"
fType(1) = 2: fData(1) = "Text_Block"
Dim pT1(0 To 2) As Double
Dim pT2(0 To 2) As Double
Dim Attr_Tag(0 To 1) As String
Dim Attr_Text(0 To 1) As String
Attr_Tag(0) = "A1": Attr_Tag(1) = "B1"
Attr_Text(0) = "Tag_No": Attr_Text(1) = "FT_x01"
pT1(0) = 0: pT1(1) = 0
pT2(0) = 500: pT2(1) = 500
SSet.Select acSelectionSetWindow, pT1, pT2, fType, fData
Dim EntObj As AcadEntity
Dim BlockRefObj As AcadBlockReference
Dim Mtextobj As AcadBlockReference
For Each EntObj In SSet
If TypeOf EntObj Is AcadBlockReference Then
Set Mtextobj = EntObj
If Mtextobj.TextString = "Here is title" Then
Exit For
Else
Exit Sub
End If
End If
Next
Dim AA As String
For Each EntObj In SSet
If TypeOf EntObj Is AcadBlockReference Then
Set BlockRefObj = EntObj
If BlockRefObj.HasAttributes Then
Attrefs = BlockRefObj.GetAttributes
For i = 0 To UBound(Attrefs)
AA = AA & Attrefs(i).TextString
MsgBox AA
Next
End If
End If
Next
End Sub
但是下来插入块怎么实现 |
|
置顶卡
