I have multiple lines (Layer Name = Checkline) that runs thru Polylines (Layer Name = 0_String). If the line intersects 3 polylines, those 3 polylines are added to a selection set, and the layer name for them are changed to 0_3 String. So intersected count per line equals Layer name..... 1 Intersect = 0_1 String, 2 Intersects = 0_2 String,....and so on. All layers are already in the drawings, I just need to assign them.
Picture 1 Before Code is run - Pink line are the checkline, white plines are 0_String
Picture 2 After code is run, it should look like this - Because checkline on far right only intersect with 1 polyline, the layer changes to 0_1 String, the 4th row of polylines from right, the checkline intersects 2 polylines, so Layername changes to 0_2 String
If intLine.IntersectWith(StringPLine, acExtendNone) <> "" I get an error here, I'm not sure how to check if intersect happend or not (Error Run-time error '13': Type Mismatch)
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
I have updated my code and removes the selection set, as there is no real need for it. The only problem I have is checking if the intPoints var is empty. If VarType(intPoints) <> vbEmpty Then , it does not seem to pick up that intPoints are empty.
As per this Image From left the layer should be 0_1 String, 0_2 String, 0_3 String per row, but it counts all 5 polylines so it uses 0_5 String Layer
EDIT: I changed If VarType(intPoints) <> vbEmpty Then to If Ubound(intPoints) <> -1 Then as the Ubound val seems to be -1 when it does not intersect. Code is Working Perfect now .
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
Per the documentation, the IntersectWith method returns a variant (of doubles, each representing a coordinate value), not a string. As such, you'll need to check whether the variant is empty.
An example of how to do this is included in the documentation linked above.