我有多条线(图层名称=检查线)穿过折线(图层名称= 0_String)。如果该线与 3 条多段线相交,则这 3 条多段线将添加到选择集中,并且它们的图层名称将更改为 0_3 String。因此每行的相交数等于图层名称..... 1 Intersect = 0_1 String, 2 Intersects = 0_2 String,....等等。所有图层都已在图纸中,我只需分配它们即可。
图1 代码运行前- 粉色线是检查线,白色线是0_String
图2 代码运行后,应该是这样的- 因为最右边的检查线只与1条折线相交,所以图层更改为0_1字符串,右数第4行折线,检查线与2条折线相交,因此Layername更改为0_2细绳
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
根据文档,该
IntersectWith
方法返回一个变体(双精度数,每个表示一个坐标值),而不是字符串。因此,您需要检查变体是否为空。上面链接的文档中包含了如何执行此操作的示例。