- 积分
- 10513
- 明经币
- 个
- 注册时间
- 2002-6-3
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2003-10-1 11:23:00
|
显示全部楼层
构建矩形使用两个对角点,也就是直线的两端点。
Sub test()
Dim SSetObj As AcadSelectionSet
On Error Resume Next
Set SSetObj = ThisDrawing.SelectionSets("Test") '创建选择集
If Err Then
Err.Clear
Set SSetObj = ThisDrawing.SelectionSets.Add("Test")
End If
SSetObj.Clear
Dim Pt1 As Variant
Dim Pt2 As Variant
'Pt1 = ThisDrawing.ModelSpace(0).StartPoint '赋值,使用已知的两个点
'Pt2 = ThisDrawing.ModelSpace(0).EndPoint
Dim groupCode(0) As Integer
Dim dataCode(0) As Variant
groupCode(0) = 0 '创建只选择直线的过滤机制,组码为0,值为"Line"
dataCode(0) = "Line"
SSetObj.Select acSelectionSetWindow, Pt1, Pt2, groupCode, dataCode '使用窗选
Dim EntObj As AcadEntity
For Each EntObj In SSetObj
'循环选择集,根据两点判断是否是需要的直线,是则删除,考虑到精度,可能还要加上误差判断。
If EntObj.StartPoint(0) = Pt1(0) And EntObj.StartPoint(1) = Pt1(1) _
And EntObj.EndPoint(0) = Pt2(0) And EntObj.EndPoint(1) = Pt2(1) Then
EntObj.Delete
Exit For
End If
Next
End Sub |
|