As per road Width, Need to classification layer-wise

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Up to 4 Meter Road Width : Street Road
4 to 10 Meter Road Width : Minor Road
10 to 20 Meter Road Width : Secondary Road
20 above Meter Road Width : Major Road
Private Sub CheckPolylineWidth()
Dim pl1 As AcadPolyline
Dim pl2 As AcadPolyline
Dim pt1 As Variant
Dim pt2 As Variant
Dim Dist As Double
' Set the "OSMODE" variable to Perpedicular
ThisDrawing.SerVariable "osmode,128"
' Select the 2 Polylines.
ThisDrawing.Utility.GetEntity pl1, pt1, "Pick the first Poliline."
pl2 = ThisDrawing.Utility.GetEntity pl1,pt2, "Pick the second Polyline to detect the Road Width."
' Check the distance between the 2 points by drawing a line then get the length of the line
Dim ln As AcadLine
Dim wd As Double
Set ln = ThisDrawing.ModelSpace.AddLine(pt1, pt2)
wd = ln.Length
If (wd <= 4) Then
'Set the layer to StreetRoad
pl1.Layer = "StreetRoad"
pl2.Layer = "StreetRoad"
ElseIf (wd > 4 And wd <= 10) Then
'Set the layer to MinorRoad
pl1.Layer = "MinorRoad"
pl2.Layer = "MinorRoad"
ElseIf (wd > 10 And wd <= 20) Then
' Set the layer to SecondaryRoad
pl1.Layer = "SecondaryRoad"
pl2.Layer = "SecondaryRoad"
ElseIf (wd > 20) Then
' Set the layer to MajorRoad
pl1.Layer = "MajorRoad"
pl2.Layer = "MajorRoad"
Else
MsgBox "Unable to determine the distance.", vbExclamation + vbOKOnly
End If
'Delete the line reference
ln.Delete
End Sub