|
|
发表于 2008-8-5 10:04:00
|
显示全部楼层
在循环中用选择集应是不好的，楼主可以考虑用插入点的距离进行判断不？
不过这样速度比较慢啊
Private Sub CommandButton1_Click()
Dim retCoord As Variant
Dim elem As AcadEntity
Dim corner1(0 To 2) As Double
Dim corner2(0 To 2) As Double
Dim dd, rr As Double
rr = 23.5651 * 2
Dim ptMin, ptMax
Dim objRec As AcadLWPolyline
'关于扩展数据的变量
Dim dataType(0 To 1) As Integer
Dim data(0 To 1) As Variant
dataType(0) = 1001: data(0) = "MY_NodeSign"
dataType(1) = 1000: data(1) = "blkMark"
'创建选择集，用于选择设备
Dim ssetObj1 As AcadSelectionSet
Dim filterType(0 To 6) As Integer
Dim filterData(0 To 6) As Variant
'安全的建立选择集
Set ssetObj1 = CreateSelectionSet("SSET1")
Dim mode As Integer
'创建两个选择集，用于选择设备
Dim ssetObj2 As AcadSelectionSet
'选择模式为通过某个区域
mode = acSelectionSetCrossing
'安全的建立选择集
'防止出现ESC错误
'On Error Resume Next
filterType(0) = 0
filterData(0) = "Insert"
filterType(1) = 100
filterData(1) = "AcDbBlockReference"
filterType(2) = -4
filterData(2) = ""
ssetObj1.Select acSelectionSetAll, , , filterType, filterData
MsgBox ssetObj1.Count
'创建图块列表、扫描模型空间集合
For Each elem In ssetObj1
retCoord = elem.InsertionPoint
'建立一个以首尾某个点为中心的长和宽为20MM的矩形
corner1(0) = retCoord(0)
corner1(1) = retCoord(1)
corner1(2) = 0
For Each elem2 In ssetObj1
If elem.Handle = elem2.Handle Then GoTo nextelem2
retCoord = elem2.InsertionPoint
corner2(0) = retCoord(0)
corner2(1) = retCoord(1)
corner2(2) = 0
dd = ((corner1(0) - corner2(0)) ^ 2 + (corner1(1) - corner2(1)) ^ 2) ^ 0.5
If dd - rr
|
|
置顶卡
