检查 AutoCAD 中的图形对象是否相交

Question

我有多条线（图层名称=检查线）穿过折线（图层名称= 0_String）。 如果该线与 3 条多段线相交，则这 3 条多段线将添加到选择集中，并且它们的图层名称将更改为 0_3 String。 所以每条线的相交数等于图层名称...... 1 个相交 = 0_1 字符串，2 个相交 = 0_2 字符串，......等等。 所有图层都已在图纸中，我只需分配它们即可。

- 粉色线是检查线，白色线是 0_String

- 因为最右边的检查线只与 1 条折线相交，所以图层更改为 0_1 String，右数第 4 行折线，检查线与 2 条折线相交，因此 Layername 更改为 0_2 String

If intLine.IntersectWith(StringPLine, acExtendNone) <> ""

我在这里遇到错误，我不知道如何检查是否发生相交（错误运行时错误'13'：类型不匹配）

Sub addLayers()

Dim intLine As AcadEntity
Dim StringPLine As AcadEntity

Dim acSelSet As AcadSelectionSet
Dim selObject As AcadEntity

' Loop through each line in the drawing
For Each intLine In ThisDrawing.ModelSpace

    ' Create a new selection set
    Set acSelSet = CreateSelectionSet("sset", ThisDrawing)

    ' Check if it is a line on the polylines
    If intLine.Layer = "0_Checkline" Then

        ' Loop through all polylines and check if it intersects
        For Each StringPLine In ThisDrawing.ModelSpace

            ' Check if the correct polylines are used
            If StringPLine.Layer = "0_String" Then

                ' Check if the line intersects with the polyline
                If intLine.IntersectWith(StringPLine, acExtendNone) <> "" Then
                    ' Add to the selection set
                    acSelSet.AddItems StringPLine
                End If

            End If
        Next

        ' Loop through each object in the selection set
        For Each selObject In acSelSet
            ' Change the layer name of the object
            selObject.Layer = "0_" & acSelSet.Count & "String"
        Next

    End If
    acSelSet.Delete
Next
End Sub

我已经更新了我的代码并删除了选择集，因为实际上并不需要它。我遇到的唯一问题是检查 intPoints var 是否为空。

If VarType(intPoints) <> vbEmpty Then

，似乎没有发现intPoints是空的。

根据此从左侧开始，每行图层应为 0_1 字符串、0_2 字符串、0_3 字符串，但它计算所有 5 条折线，因此使用 0_5 字符串图层

编辑：我将

If VarType(intPoints) <> vbEmpty Then

更改为

If Ubound(intPoints) <> -1 Then

，因为 Ubound 值在不相交时似乎为 -1。现在代码是 .

Sub addLayers()

Dim intLine As AcadEntity
Dim intPoints As Variant
Dim entPoly As AcadEntity
Dim acadOb(0 To 7) As AcadEntity

Dim i As Long
i = 0

Dim k As Long

'///Looping thru each line in drawing
For Each intLine In ThisDrawing.ModelSpace

    'Checks if it is a Line on the polylines
    If intLine.Layer = "0_Checkline" Then

        '///Looping thru all polylines and checking if it intersects with
        For Each entPoly In ThisDrawing.ModelSpace
            'check if correct polylines are used
            If entPoly.Layer = "0_String" Then
                'Check if Line intersects polyline
                intPoints = intLine.IntersectWith(entPoly, acExtendNone)
                    If UBound(intPoints) <> -1 Then
                        
                      'add object to array
                       Set acadOb(i) = entPoly
                       i = i + 1
                         
                    Else
                         MsgBox ("Var Empty")
                    End If
                    
            End If
        Next
       
        For k = 0 To 7
        On Error Resume Next
        acadOb(k).Layer = "0_" & i & " String"
       
        Next
       
        'Reset I if new Inline is searched
        i = 0
        Erase acadOb()
    End If
  
Next

End Sub

Answer 1

根据 documentation，

IntersectWith

方法返回一个变体（双精度数，每个表示一个坐标值），而不是字符串。因此，您需要检查变体是否为空。

上面链接的文档中包含如何执行此操作的示例。