CAD_VBA中的選擇集過(guò)濾.doc

CAD中的選擇集過(guò)濾一、選擇集過(guò)濾時(shí)的使用方式如下：Object 指使用SelectionSet這個(gè)方法適用的對(duì)象運(yùn)用select方法上面的例題已經(jīng)運(yùn)用了select方法,下面講一下select的5種Mode選擇方式:1:擇全部對(duì)象(acselectionsetall)2.選擇上次創(chuàng)建的對(duì)象(acselectionsetlast)3.選擇上次選擇的對(duì)象(acselectionsetprevious)4.選擇矩形窗口內(nèi)對(duì)象(acselectionsetwindow)5.選擇矩形窗口內(nèi)以及與邊界相交的對(duì)象(acselectionsetcrossing)1) object.Select Mode, Point1, Point2, FilterType, FilterData2) object.SelectOnScreen FilterType, FilterData3) object.SelectAtPoint Point, FilterType, FilterDataFilterType:Variant變體(整數(shù)數(shù)組); 僅用于輸入;(可選項(xiàng)) 指定使用的過(guò)濾器類型的 DXF 組碼。 FilterData:Variant變體(變體數(shù)組); 僅用于輸入;(可選項(xiàng)) 過(guò)濾器的值。 二、DXF群組碼共同群組碼代碼一覽表群碼說(shuō)明預(yù)設(shè)值-4過(guò)濾群組方式,例如 、單一條件時(shí)可省略-1圖元名稱(會(huì)隨每一個(gè)圖檔開啟而有所不同)不可省略0圖元類型,例如 ARC、 LINE、CIRCLE.不可省略5處理碼不可省略6線型名稱(如果線型不為BYLAYER,此群碼值會(huì)出現(xiàn))BYLAYER8圖層名稱不可省略48線性比例(選擇性)1.060物件可見性, 0=可見, 1=不可見062顏色編號(hào) (如果線型不為BYLAYER,此群群碼會(huì)出現(xiàn))當(dāng)值為0時(shí),即指BYLAYER,如果是負(fù)值即指該圖層是關(guān)閉的(選擇性)BYLAYER67值為空或0時(shí)即指圖元在模型空間,如果為1指在圖形空間0三、過(guò)濾群組方式- FilterType (DXF 群組碼) = -4過(guò)濾群組方式內(nèi)含項(xiàng)目描述運(yùn)算法則1 或 多個(gè)所有項(xiàng)目的交集1+1=1, 1+0=0, 0+1=0, 0+0=01 或多個(gè)所有項(xiàng)目的并集1+1=1, 1+0=1, 0+1=1, 0+0=02個(gè)兩個(gè)項(xiàng)目的異或運(yùn)算1+1=0, 1+0=1, 0+1=1, 0+0=01個(gè)不包含此項(xiàng)目的值NOT(1)=0,NOT(0)=1四、范例：1、過(guò)濾條件為圖元為MTEXT圖元是MTEXTFilterDataMTEXTFilterType02、過(guò)濾條件為圖元為CIRCLE或LINE圖元是CIRCLE OR 圖元是LINEFilterDataFilterType-400-43、過(guò)濾條件為圖元在DIM 圖層(LAYER)中的CIRCLE或LINE (圖元是CIRCLE OR 圖元是LINE) AND 圖層位于DIM層FilterDataANDDIMANDFilterType-4-400-48-44、過(guò)濾的條件為圖元為CIRCLE或LINE但圖層(LAYER)不屬于DIM層(圖元是CIRCLE OR 圖元是LINE) AND NOT(圖層位于DIM層)FilterDataANDANDFilterType-4-400-4-48-4-4名稱：獲取與修改AutoCAD Entity的XData功能：獲取與修改AutoCAD Entity的XData。源代碼：南方CASS實(shí)體編碼的應(yīng)用程序名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 = 編號(hào) Next a Else D_type(0) = 1001: D_data(0) = LSZD D_type(1) = 1000: D_data(1) = D_BH Set FW_LWPL