|
|
发表于 2005-1-6 19:19:00
|
显示全部楼层
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.Interop
Imports Autodesk.AutoCAD.Interop.Common
Imports Autodesk.AutoCAD.Geometry
Public Class TlsSelectionSet
Private m_oSel As AcadSelectionSet
Private m_vFilterType() As Short, m_vFilterData() As Object
Private m_sName As String
Private m_oApp As AcadApplication = Application.AcadApplication
Private m_oDoc As AcadDocument
Public Sub NullFilter()
'清空过滤器
m_vFilterType = Nothing
m_vFilterData = Nothing
End Sub
Private Function IsNull() As Boolean
If m_oSel Is Nothing Then
IsNull = True
ElseIf m_oSel.Count = 0 Then
IsNull = True
Else
IsNull = False
End If
End Function
Public Sub New()
Me.New("TlsSel")
End Sub
Public Sub New(ByVal Name As String)
m_oDoc = m_oApp.ActiveDocument
Init(Name)
End Sub
Public Sub Init(ByVal Name As String)
'创建选择集
NullFilter()
If Not m_oSel Is Nothing Then m_oSel.Delete()
m_sName = Name
Try
m_oDoc.SelectionSets.Item(m_sName).Delete()
Catch ex As Exception
End Try
m_oSel = m_oDoc.SelectionSets.Add(m_sName)
End Sub
Protected Overrides Sub Finalize()
MyBase.Finalize()
If Not m_oSel Is Nothing Then m_oSel.Delete()
End Sub
Public ReadOnly Property Count() As Integer
'获取选择集实体个数
Get
Count = m_oSel.Count
End Get
End Property
Public ReadOnly Property Name() As String
'获取选择集名称
Get
Name = m_sName
End Get
End Property
Public ReadOnly Property Item(ByVal Index) As AcadEntity
'获取选择集实体
Get
Item = m_oSel.Item(Index)
End Get
End Property
Public Sub AddItem(ByVal obj As AcadEntity)
'向选择集加入单个实体
Dim objs(0) As AcadEntity
objs(0) = obj
m_oSel.AddItems(objs)
End Sub
Public Sub AddItem(ByVal objs As AcadEntity())
'向选择集加入实体数组
m_oSel.AddItems(objs)
End Sub
Public Sub RemoveItem(ByVal obj As AcadEntity)
'在选择集中移除单个实体
Dim objs(0) As AcadEntity
objs(0) = obj
m_oSel.RemoveItems(objs)
End Sub
Public Sub RemoveItem(ByVal objs As AcadEntity())
'在选择集中移除实体数组
m_oSel.RemoveItems(objs)
End Sub
Public Sub Clear()
'清空选择集
Select Case m_sName
Case "ICKFIRST"
GetPickfirstSelectionSet()
Case "CURRENT"
GetActiveSelectionSet()
Case Else
Init(m_sName)
End Select
m_oSel.Clear()
End Sub
Public Sub Update()
m_oSel.Update()
End Sub
Public Sub GetPickfirstSelectionSet()
'获取Pickfirst选择集
NullFilter()
If Not m_oSel Is Nothing Then m_oSel.Delete()
m_sName = "ICKFIRST"
m_oDoc.SelectionSets.Item(m_sName).Delete()
m_oSel = m_oDoc.PickfirstSelectionSet
End Sub
Public Sub GetActiveSelectionSet()
'获取Active选择集
On Error Resume Next
NullFilter()
If Not m_oSel Is Nothing Then m_oSel.Delete()
m_sName = "CURRENT"
m_oDoc.SelectionSets.Item(m_sName).Delete()
m_oSel = m_oDoc.ActiveSelectionSet
End Sub
Public Sub SetFilterType(ByVal ParamArray FilterType())
'设置过滤器类型
Dim i
Dim nCount As Short
nCount = UBound(FilterType)
ReDim m_vFilterType(nCount)
For i = 0 To nCount
m_vFilterType(i) = FilterType(i)
Next i
End Sub
Public Sub SetFilterData(ByVal ParamArray FilterData())
'设置过滤器数据
Dim i
Dim nCount As Integer
nCount = UBound(FilterData)
ReDim m_vFilterData(nCount)
For i = 0 To nCount
m_vFilterData(i) = FilterData(i)
Next i
End Sub
Public Sub SetFilter(ByVal ParamArray Filter())
'设置过滤器
Dim i
Dim n As Integer
Dim nCount As Integer
nCount = (UBound(Filter) + 1) / 2 - 1
ReDim m_vFilterType(nCount), m_vFilterData(nCount)
For i = 0 To nCount
n = i * 2
m_vFilterType(i) = Filter(n)
m_vFilterData(i) = Filter(n + 1)
Next i
End Sub
Public Sub SelectObjectOnScreen()
If IsArray(m_vFilterType) Then
m_oSel.SelectOnScreen(m_vFilterType, m_vFilterData)
Else
m_oSel.SelectOnScreen()
End If
End Sub
Public Sub SelectObject(ByVal Mode As AcSelect, ByVal Point1 As Object, ByVal Point2 As Object)
If IsArray(m_vFilterType) Then
m_oSel.Select(Mode, Point1, Point2, m_vFilterType, m_vFilterData)
Else
m_oSel.Select(Mode, Point1, Point2)
End If
End Sub
Public Sub SelectObject(ByVal Mode As AcSelect)
If IsArray(m_vFilterType) Then
m_oSel.Select(Mode, , , m_vFilterType, m_vFilterData)
Else
m_oSel.Select(Mode)
End If
End Sub
Public Sub SelectObjectAtPoint(ByVal Point)
On Error Resume Next
If IsArray(m_vFilterType) Then
m_oSel.SelectAtPoint(Point, m_vFilterType, m_vFilterData)
Else
m_oSel.SelectAtPoint(Point)
End If
End Sub
Public Sub SelectObjectByPolygon(ByVal Mode As AcSelect, ByVal Points As Object)
If IsArray(m_vFilterType) Then
m_oSel.SelectByPolygon(Mode, Points, m_vFilterType, m_vFilterData)
Else
m_oSel.SelectByPolygon(Mode, Points)
End If
End Sub
Public WriteOnly Property Visible() As Boolean
Set(ByVal Value As Boolean)
If IsNull() Then Exit Property
Dim i As AcadEntity
For Each i In m_oSel
i.Visible = Value
Next i
End Set
End Property
Public WriteOnly Property Layer() As String
Set(ByVal Value As String)
If IsNull() Then Exit Property
Dim i As AcadEntity
For Each i In m_oSel
i.Layer = Value
Next i
End Set
End Property
Public WriteOnly Property LineType() As String
Set(ByVal Value As String)
If IsNull() Then Exit Property
Dim i As AcadEntity
For Each i In m_oSel
i.Linetype = Value
Next i
End Set
End Property
Public WriteOnly Property Color() As ACAD_COLOR
Set(ByVal Value As ACAD_COLOR)
If IsNull() Then Exit Property
Dim i As AcadEntity
For Each i In m_oSel
i.color = Value
Next i
End Set
End Property
Public Sub Move(ByVal Point1 As Object, ByVal Point2 As Object)
If IsNull() Then Exit Sub
Dim i As AcadEntity
For Each i In m_oSel
i.Move(Point1, Point2)
Next i
End Sub
Public Function Copy(ByVal Point1 As Object, ByVal Point2 As Object) As AcadEntity()
If IsNull() Then Exit Function
Dim objs() As AcadEntity
Dim i
ReDim objs(Count - 1)
For i = 0 To Count
objs(i) = m_oSel.Item(i).Copy
objs(i).Move(Point1, Point2)
Next i
Return objs
End Function
Public Sub Rotate(ByVal BasePoint As Object, Optional ByVal RotationAngle As Double = 1.0#)
If IsNull() Then Exit Sub
Dim i As AcadEntity
For Each i In m_oSel
i.Rotate(BasePoint, RotationAngle)
Next i
End Sub
Public Sub Rotate3D(ByVal Point1 As Object, ByVal Point2 As Object, Optional ByVal RotationAngle As Double = 1.0#)
If IsNull() Then Exit Sub
Dim i As AcadEntity
For Each i In m_oSel
i.Rotate3D(Point1, Point2, RotationAngle)
Next i
End Sub
Public Sub ScaleAll(ByVal BasePoint As Object, Optional ByVal ScaleFactor As Double = 1)
If IsNull() Then Exit Sub
Dim i As AcadEntity
For Each i In m_oSel
i.ScaleEntity(BasePoint, ScaleFactor)
Next i
End Sub
Public Sub Mirror(ByVal Point1 As Object, ByVal Point2 As Object)
If IsNull() Then Exit Sub
Dim i As AcadEntity
For Each i In m_oSel
i.Mirror(Point1, Point2)
Next i
End Sub
Public Sub Mirror3D(ByVal Point1 As Object, ByVal Point2 As Object, ByVal Point3 As Object)
If IsNull() Then Exit Sub
Dim i As AcadEntity
For Each i In m_oSel
i.Mirror3D(Point1, Point2, Point3)
Next i
End Sub
Public Sub Highlight(Optional ByVal HighlightFlag As Boolean = True)
Dim i As AcadEntity
For Each i In m_oSel
i.Highlight(HighlightFlag)
Next i
End Sub
Public Sub Delete()
m_oSel.Erase()
End Sub
Public Sub CopyObjects(ByVal Owner As Object, ByVal IdPairs As Object)
If IsNull() Then Exit Sub
m_oDoc.CopyObjects(ToArray, Owner, IdPairs)
End Sub
Public Sub CopyObjects(ByVal Owner As Object)
If IsNull() Then Exit Sub
m_oDoc.CopyObjects(ToArray, Owner)
End Sub
Public Sub CopyObjects()
If IsNull() Then Exit Sub
m_oDoc.CopyObjects(ToArray)
End Sub
Public Function GetBoundingBox(ByRef MinPoint As Object, ByRef MaxPoint As Object) As Boolean
Dim i
Dim d1, d2, p1, p2
If IsNull() Then Exit Function
m_oSel.Item(0).GetBoundingBox(d1, d2)
For i = 1 To Count - 1
m_oSel.Item(i).GetBoundingBox(p1, p2)
If p1(0) d2(0) Then d2(0) = p2(0)
If p2(1) > d2(1) Then d2(1) = p2(1)
Next i
MinPoint = d1
MaxPoint = d2
End Function
Public Function ToBlock(ByVal InsertionPoint As Object, Optional ByVal Name As String = "*U") As String
If IsNull() Then Exit Function
Dim oBlock As AcadBlock
oBlock = m_oDoc.Blocks.Add(InsertionPoint, Name)
CopyObjects(oBlock)
Return oBlock.Name
End Function
Public Function ToSelectionSet() As AcadSelectionSet
'获取选择集
Return m_oSel
End Function
Public Function ToArray()
'转化选择集为对象数组输出
Dim i
Dim objs() As AcadEntity
Dim nCount As Integer
nCount = m_oSel.Count - 1
ReDim objs(nCount)
For i = 0 To nCount
objs(i) = m_oSel.Item(i)
Next i
Return objs
End Function
Public Function ToObjectIdCollection() As ObjectIdCollection
'转化选择集为对象数组输出
Dim i
Dim objId As ObjectId
Dim objs As New ObjectIdCollection
For i = 0 To m_oSel.Count - 1
objId.OldId = m_oSel.Item(i).ObjectID
objs.Add(objId)
Next i
Return objs
End Function
End Class
|
|
置顶卡
