[讨论]：选择集在VBA中的操作

efan2000 · 发表于 2002-12-9 19:20:11

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

先介绍几个关于选择集的删除操作吧。
1、Clear:：Clear方法是清空选择集。选择集依然存在，但不包含任何实体对象。这些实体对象仍驻留在图形数据库中，只是不再与该选择集关联。
2、RemoveItems：RemoveItems方法是从选择集中清除一个或者多个实体对象。这些被清除的实体对象仍旧驻留在图形数据库中，只是不再与该选择集关联。
3、Erase：Erase方法是删除选择集中的所有实体，选择集仍然存在，但不包含任何实体对象。被删除的实体对象也将在图形数据库中清除，即在图上已经消失。
4、Delete：Delete方法是删除选择集本身连同所有的实体对象，选择集将不再存在，但被删除的实体对象仍旧驻留在图形数据库中。

efan2000 · 发表于 2002-12-9 19:59:20

下面介绍几个对选择集操作的函数，就像对单个实体那样，VBA没有提供对选择集中的所有实体进行操作的功能。

[FONT=courier new]
' 圆形阵列
Sub ssetArrayPolar(ByVal ssetObj As AcadSelectionSet, ByVal NumberOfObjects As Long, ByVal AngleToFill As Double, ByVal CenterPoint As Variant)
Dim i As Integer
On Error GoTo ErrTrap
For i = 0 To ssetObj.Count - 1
ssetObj(i).ArrayPolar NumberOfObjects, AngleToFill, CenterPoint
Next
Exit Sub
ErrTrap:
On Error GoTo 0
End Sub
' 矩形陈列
Sub ssetArrayRectangular(ByVal ssetObj As AcadSelectionSet, ByVal NumberOfRows As Long, ByVal NumberOfColumns As Long, ByVal NumberOfLevels As Long, ByVal DistBetweenRows As Double, ByVal DistBetweenCols As Double, ByVal DisBetweenLevels As Double)
Dim i As Integer
On Error GoTo ErrTrap
For i = 0 To ssetObj.Count - 1
ssetObj(i).ArrayRectangular NumberOfRows, NumberOfColumns, NumberOfLevels, DistBetweenRows, DistBetweenCols, DisBetweenLevels
Next
Exit Sub
ErrTrap:
On Error GoTo 0
End Sub
' 镜像
Sub ssetMirror(ByVal ssetObj As AcadSelectionSet, ByVal Point1 As Variant, ByVal Point2 As Variant)
Dim i As Integer
On Error GoTo ErrTrap
For i = 0 To ssetObj.Count - 1
ssetObj(i).Mirror Point1, Point2
Next
Exit Sub
ErrTrap:
On Error GoTo 0
End Sub
' 三维镜像
Sub ssetMirror3D(ByVal ssetObj As AcadSelectionSet, ByVal Point1 As Variant, ByVal Point2 As Variant, ByVal Point3 As Variant)
Dim i As Integer
On Error GoTo ErrTrap
For i = 0 To ssetObj.Count - 1
ssetObj(i).Mirror3D Point1, Point2, Point3
Next
Exit Sub
ErrTrap:
On Error GoTo 0
End Sub
' 移动
Sub ssetMove(ByVal ssetObj As AcadSelectionSet, ByVal FromPoint As Variant, ByVal ToPoint As Variant)
Dim i As Integer
On Error GoTo ErrTrap
For i = 0 To ssetObj.Count - 1
ssetObj(i).Move FromPoint, ToPoint
Next
Exit Sub
ErrTrap:
On Error GoTo 0
End Sub
' 旋转
Sub ssetRotate(ByVal ssetObj As AcadSelectionSet, ByVal BasePoint As Variant, ByVal RotationAngle As Double)
Dim i As Integer
On Error GoTo ErrTrap
For i = 0 To ssetObj.Count - 1
ssetObj(i).Rotate BasePoint, RotationAngle
Next
Exit Sub
ErrTrap:
On Error GoTo 0
End Sub
' 三维旋转
Sub ssetRotate3D(ByVal ssetObj As AcadSelectionSet, ByVal Point1 As Variant, ByVal Point2 As Variant, ByVal RotationAngle As Double)
Dim i As Integer
On Error GoTo ErrTrap
For i = 0 To ssetObj.Count - 1
ssetObj(i).Rotate3D Point1, Point2, RotationAngle
Next
Exit Sub
ErrTrap:
On Error GoTo 0
End Sub
' 比例缩放
Sub ssetScaleEntity(ByVal ssetObj As AcadSelectionSet, ByVal BasePoint As Variant, ByVal ScaleFactor As Double)
Dim i As Integer
On Error GoTo ErrTrap
For i = 0 To ssetObj.Count - 1
ssetObj(i).ScaleEntity BasePoint, ScaleFactor
Next
Exit Sub
ErrTrap:
On Error GoTo 0
End Sub
' 矩阵操作
Sub ssetTransformBy(ByVal ssetObj As AcadSelectionSet, ByVal TransformationMatrix As Variant)
Dim i As Integer
On Error GoTo ErrTrap
For i = 0 To ssetObj.Count - 1
ssetObj(i).TransformBy TransformationMatrix
Next
Exit Sub
ErrTrap:
On Error GoTo 0
End Sub
[/FONT]

[FONT=courier new] 
' 圆形阵列 
Sub ssetArrayPolar(ByVal ssetObj As AcadSelectionSet, ByVal NumberOfObjects As Long, ByVal AngleToFill As Double, ByVal CenterPoint As Variant) 
    Dim i As Integer 
    
    On Error GoTo ErrTrap 
    For i = 0 To ssetObj.Count - 1 
        ssetObj(i).ArrayPolar NumberOfObjects, AngleToFill, CenterPoint 
    Next 
    Exit Sub 
    
ErrTrap: 
    On Error GoTo 0 
End Sub 
 
' 矩形陈列 
Sub ssetArrayRectangular(ByVal ssetObj As AcadSelectionSet, ByVal NumberOfRows As Long, ByVal NumberOfColumns As Long, ByVal NumberOfLevels As Long, ByVal DistBetweenRows As Double, ByVal DistBetweenCols As Double, ByVal DisBetweenLevels As Double) 
    Dim i As Integer 
    
    On Error GoTo ErrTrap 
    For i = 0 To ssetObj.Count - 1 
        ssetObj(i).ArrayRectangular NumberOfRows, NumberOfColumns, NumberOfLevels, DistBetweenRows, DistBetweenCols, DisBetweenLevels 
    Next 
    Exit Sub 
    
ErrTrap: 
    On Error GoTo 0 
End Sub 
 
' 镜像 
Sub ssetMirror(ByVal ssetObj As AcadSelectionSet, ByVal Point1 As Variant, ByVal Point2 As Variant) 
    Dim i As Integer 
    
    On Error GoTo ErrTrap 
    For i = 0 To ssetObj.Count - 1 
        ssetObj(i).Mirror Point1, Point2 
    Next 
    Exit Sub 
    
ErrTrap: 
    On Error GoTo 0 
End Sub 
 
' 三维镜像 
Sub ssetMirror3D(ByVal ssetObj As AcadSelectionSet, ByVal Point1 As Variant, ByVal Point2 As Variant, ByVal Point3 As Variant) 
    Dim i As Integer 
    
    On Error GoTo ErrTrap 
    For i = 0 To ssetObj.Count - 1 
        ssetObj(i).Mirror3D Point1, Point2, Point3 
    Next 
    Exit Sub 
    
ErrTrap: 
    On Error GoTo 0 
End Sub 
 
' 移动 
Sub ssetMove(ByVal ssetObj As AcadSelectionSet, ByVal FromPoint As Variant, ByVal ToPoint As Variant) 
    Dim i As Integer 
    
    On Error GoTo ErrTrap 
    For i = 0 To ssetObj.Count - 1 
        ssetObj(i).Move FromPoint, ToPoint 
    Next 
    Exit Sub 
    
ErrTrap: 
    On Error GoTo 0 
End Sub 
 
' 旋转 
Sub ssetRotate(ByVal ssetObj As AcadSelectionSet, ByVal BasePoint As Variant, ByVal RotationAngle As Double) 
    Dim i As Integer 
    
    On Error GoTo ErrTrap 
    For i = 0 To ssetObj.Count - 1 
        ssetObj(i).Rotate BasePoint, RotationAngle 
    Next 
    Exit Sub 
    
ErrTrap: 
    On Error GoTo 0 
End Sub 
 
' 三维旋转 
Sub ssetRotate3D(ByVal ssetObj As AcadSelectionSet, ByVal Point1 As Variant, ByVal Point2 As Variant, ByVal RotationAngle As Double) 
    Dim i As Integer 
    
    On Error GoTo ErrTrap 
    For i = 0 To ssetObj.Count - 1 
        ssetObj(i).Rotate3D Point1, Point2, RotationAngle 
    Next 
    Exit Sub 
    
ErrTrap: 
    On Error GoTo 0 
End Sub 
 
' 比例缩放 
Sub ssetScaleEntity(ByVal ssetObj As AcadSelectionSet, ByVal BasePoint As Variant, ByVal ScaleFactor As Double) 
    Dim i As Integer 
    
    On Error GoTo ErrTrap 
    For i = 0 To ssetObj.Count - 1 
        ssetObj(i).ScaleEntity BasePoint, ScaleFactor 
    Next 
    Exit Sub 
    
ErrTrap: 
    On Error GoTo 0 
End Sub 
 
' 矩阵操作 
Sub ssetTransformBy(ByVal ssetObj As AcadSelectionSet, ByVal TransformationMatrix As Variant) 
    Dim i As Integer 
    
    On Error GoTo ErrTrap 
    For i = 0 To ssetObj.Count - 1 
        ssetObj(i).TransformBy TransformationMatrix 
    Next 
    Exit Sub 
    
ErrTrap: 
    On Error GoTo 0 
End Sub 
 
  [/FONT]

账号		自动登录	找回密码
密码			立即注册

[讨论]：选择集在VBA中的操作

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

浏览过的版块