[求助]选择集选取语法没错，为什么会漏选图元呢？求助高手！！

junhua1123 · 发表于 2008-3-18 18:27:00

本帖最后由作者于 2008-3-18 20:53:25 编辑

检查了好几遍，没发现出问题，但是求不出所有的交点，是选择集出了问题，没有选取所以符合条件的图元。

至于为什么没有选到，就不知道了，求助高手啊。

语法应该没有问题

Private Sub CommandButton1_Click()

On Error Resume Next
UserForm1.Hide

'选择等高线
Dim EntObj(0 To 0) As AcadEntity
Dim PPt As Variant

ThisDrawing.Utility.GetEntity EntObj(0), PPt, "选择等高线: "
If EntObj(0) Is Nothing Then Exit Sub

'求直线的外框
Dim Pt1 As Variant
Dim Pt2 As Variant
EntObj(0).GetBoundingBox Pt1, Pt2

'创建选择集
Dim ssetObj As AcadSelectionSet
Set ssetObj = ThisDrawing.SelectionSets("SSET")
If Err Then Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")
ssetObj.Clear

'只选取图层为DGX的图层
'选择与该直线相交或者包含在外框中的所有实体
Dim fType(0) As Integer
Dim fData(0) As Variant

fType(0) = 8: fData(0) = "dgx"
ssetObj.Select acSelectionSetCrossing, Pt1, Pt2, fType, fData

'由于其中包含了自身实体，故应从选择集中移走
'由于移去函数的参数是对象集合，所以在上面定义的是单个对象的对象集合
ssetObj.RemoveItems EntObj

Dim entTempElev As Double

entTempElev = EntObj(0).Elevation
EntObj(0).Elevation = 0

'将等高线高程暂时化为0，原高程存储到数组elevTemp（）中
Dim I As Integer

Dim elevTemp() As Double
ReDim elevTemp(1 To ssetObj.Count)

For I = 1 To ssetObj.Count
    elevTemp(I) = ssetObj.Item(I).Elevation
    ssetObj.Item(I).Elevation = 0
    ssetObj.Item(I).Update
Next

'枚举交点，判断是否相交
Dim pts As Variant
Dim circle1() As AcadCircle
ReDim circle1(ssetObj.Count - 1)
Dim a As Integer

For I = 0 To ssetObj.Count - 1
    pts = ssetObj(I).IntersectWith(EntObj(0), acExtendNone)
    If Not IsEmpty(pts) Then
        Dim circleT(2) As Double
        circleT(0) = pts(0): circleT(1) = pts(1): circleT(2) = 0

        circle1(I) = ThisDrawing.ModelSpace.AddCircle(circleT, 0.5)

End If
Next

EntObj(0).Elevation = entTempElev
For I = 1 To ssetObj.Count
ssetObj.Item(I).Elevation = elevTemp(I)
ssetObj.Item(I).Update
Next

UserForm1.Show
End Sub

王咣生 · 发表于 2008-3-18 20:40:00

我选择黑线,然后求得了交点:

没发现什么问题!

junhua1123 · 发表于 2008-3-18 20:51:00

你用那根等高线试试，就是我贴图上的那根与另外好几根差不多同样属性的多段线试试

我试验的时候，结果想贴图的那样，应该有6个交点的，但实际只画了5个圆，只返回5个交点

jxh2003zfr · 发表于 2008-3-18 23:25:00

本帖最后由作者于 2008-3-18 23:31:30 编辑

以下红色为错误,已更改，再试试，呵呵，粗心了点

Option Explicit