CAD_VBA中的選擇集過濾.doc

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