As per road Width, Need to classification layer-wise

As per road Width, Need to classification layer-wise

Anonymous
Not applicable
401 Views
0 Replies
Message 1 of 1

As per road Width, Need to classification layer-wise

Anonymous
Not applicable

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

0 Likes
402 Views
0 Replies
Replies (0)