CAD_VBA中的选择集过滤.doc

CAD中的选择集过滤一、选择集过滤时的使用方式如下：Object 指使用SelectionSet这个方法适用的对象运用select方法上面的例题已经运用了select方法,下面讲一下select的5种Mode选择方式:1:择全部对象(acselectionsetall)2.选择上次创建的对象(acselectionsetlast)3.选择上次选择的对象(acselectionsetprevious)4.选择矩形窗口内对象(acselectionsetwindow)5.选择矩形窗口内以及与边界相交的对象(acselectionsetcrossing)1) object.Select Mode, Point1, Point2, FilterType, FilterData2) object.SelectOnScreen FilterType, FilterData3) object.SelectAtPoint Point, FilterType, FilterDataFilterType:Variant变体(整数数组); 仅用于输入;(可选项) 指定使用的过滤器类型的 DXF 组码。 FilterData:Variant变体(变体数组); 仅用于输入;(可选项) 过滤器的值。 二、DXF群组码共同群组码代码一览表群码说明预设值-4过滤群组方式,例如 、单一条件时可省略-1图元名称(会随每一个图档开启而有所不同)不可省略0图元类型,例如 ARC、 LINE、CIRCLE.不可省略5处理码不可省略6线型名称(如果线型不为BYLAYER,此群码值会出现)BYLAYER8图层名称不可省略48线性比例(选择性)1.060物件可见性, 0=可见, 1=不可见062颜色编号 (如果线型不为BYLAYER,此群群码会出現)当值为0時,即指BYLAYER,如果是负值即指该图层是关闭的(选择性)BYLAYER67值为空或0时即指图元在模型空间,如果为1指在图形空间0三、过滤群组方式- FilterType (DXF 群组码) = -4过滤群组方式內含项目描述运算法则1 或 多个所有项目的交集1+1=1, 1+0=0, 0+1=0, 0+0=01 或多个所有项目的并集1+1=1, 1+0=1, 0+1=1, 0+0=02个两个项目的异或运算1+1=0, 1+0=1, 0+1=1, 0+0=01个不包含此项目的值NOT(1)=0,NOT(0)=1四、范例：1、过滤条件为图元为MTEXT图元是MTEXTFilterDataMTEXTFilterType02、过滤条件为图元为CIRCLE或LINE图元是CIRCLE OR 图元是LINEFilterDataFilterType-400-43、过滤条件为图元在DIM 图层(LAYER)中的CIRCLE或LINE (图元是CIRCLE OR 图元是LINE) AND 图层位于DIM层FilterDataANDDIMANDFilterType-4-400-48-44、过滤的条件为图元为CIRCLE或LINE但图层(LAYER)不属于DIM层(图元是CIRCLE OR 图元是LINE) AND NOT(图层位于DIM层)FilterDataANDANDFilterType-4-400-4-48-4-4名称：获取与修改AutoCAD Entity的XData功能：获取与修改AutoCAD Entity的XData。源代码：南方CASS实体编码的应用程序名strAppName=southPublic Function GetCode(objEnt As AcadEntity, strAppName As String) As Variant Dim dType As Variant, dData As Variant, i As Integer If HasXData(objEnt, strAppName) = False Then GetCode = Else objEnt.GetXData strAppName, dType, dData For i = LBound(dType) To UBound(dType) If dType(i) = 1000 Then GetCode = dData(i) Exit For End If Next i End IfEnd FunctionPublic Function SetCode(ByVal objEnt As AcadEntity, ByVal strText As String, ByVal strAppName As String) Dim dType(0 To 1) As Integer Dim mData(0 To 1) As Variant dType(0) = 1001: mData(0) = strAppName dType(1) = 1000: mData(1) = strText objEnt.SetXData dType, mDataEnd FunctionPublic Function HasXData(ByVal ent As AcadEntity, ByVal strAppName As String) As Boolean Dim dataType As Variant Dim Data As Variant ent.GetXData strAppName, dataType, Data HasXData = True If IsEmpty(dataType) Then HasXData = False End IfEnd Function Dim SET_PL As AcadSelectionSet Dim SET_name As String SET_name = setname Dim F_type(0 To 7) As Integer Dim F_data(0 To 7) As Variant F_type(0) = -4: F_data(0) = F_type(4) = -4: F_data(4) = On Error Resume Next If Not IsNull(ThisDrawing.SelectionSets.Item(SET_name) Then Set SET_PL = ThisDrawing.SelectionSets.Item(SET_name) SET_PL.Delete End If Set SET_PL = ThisDrawing.SelectionSets.Add(SET_name) SET_PL.SelectOnScreen F_type, F_data Dim n As Integer, i As Integer n = SET_PL.Count - 1 Dim D_BH As Integer D_BH = 0 For i = 0 To n Dim PL_coor() As Double Dim Dt_lwpl As AcadLWPolyline, Dt_pl As AcadPolyline Dim m As Integer, j As Integer D_BH = D_BH + 1 If SET_PL.Item(i).ObjectName = AcDbPolyline Then Set Dt_lwpl = SET_PL.Item(i) m = (UBound(Dt_lwpl.Coordinates) + 1) * 3 / 2 - 1 ReDim PL_coor(m) For j = 0 To m PL_coor(3 * j) = Dt_lwpl.Coordinates(2 * j) PL_coor(3 * j + 1) = Dt_lwpl.Coordinates(2 * j + 1) PL_coor(3 * j + 2) = 0 Next j ElseIf SET_PL.Item(i).ObjectName = AcDb2dPolyline Then Set Dt_pl = SET_PL.Item(i) m = UBound(Dt_pl.Coordinates) / 3 ReDim PL_coor(m) For j = 0 To m PL_coor(3 * j) = Dt_pl.Coordinates(3 * j) PL_coor(3 * j + 1) = Dt_pl.Coordinates(3 * j + 1) PL_coor(3 * j + 2) = Dt_pl.Coordinates(3 * j + 2) Next j End If Dim set_DZ As AcadSelectionSet Dim setDZ_name As String setDZ_name = DZ_LWpl Dim FT_type(1) As Integer Dim FT_data(1) As Variant FT_type(0) = 0: FT_data(0) = LWPOLYLINE FT_type(1) = 8: FT_data(1) = JMD If Not IsNull(ThisDrawing.SelectionSets.Item(setDZ_name) Then Set set_DZ = ThisDrawing.SelectionSets.Item(setDZ_name) set_DZ.Delete End If Set set_DZ = ThisDrawing.SelectionSets.Add(setDZ_name) set_DZ.SelectByPolygon acSelectionSetCrossingPolygon, PL_coor, FT_type, FT_data Dim FS As Integer, a As Integer Dim FW_LWPL As AcadLWPolyline, HAO As String Dim D_type(0 To 1) As Integer Dim D_data(0 To 1) As Variant Dim Insert_point(2) As Double Dim BH As AcadText FS = set_DZ.Count - 1 If FS 0 Then For a = 0 To FS HAO = D_BH & - & (a + 1) D_type(0) = 1001: D_data(0) = LSZD D_type(1) = 1000: D_data(1) = HAO Set FW_LWPL = set_DZ(a) FW_PL.SetXData D_type, D_data Insert_point(0) = FW_LWPL.Coordinates(0) Insert_point(1) = FW_LWPL.Coordinates(1) Insert_point(2) = 0 Set BH = ThisDrawing.ModelSpace.AddText(HAO, Insert_point, 2) BH.Layer = 编号 Next a Else D_type(0) = 1001: D_data(0) = LSZD D_type(1) = 1000: D_data(1) = D_BH Set FW_LWPL