Maximum Stopping Sight Distance Lisp

[Sideshow-Cad]

Hello guys,

 

I am wanting to measure the maximum stopping sight distance from lane 1 of a carriageway (pline 1) to the central reserve barrier (pline 2)at multiple intervals along the route.

 

I am looking for a lisp command that draws multiple straight lines at specified intervals from pline1, at their max length before they touch pline 2. The two lines may not be perfectly parallel.

 

Can anyone help me?

 

Thanks in advance.

[Tharwat]

Welcome to the forum .

 

Are you aware of the command divide ?

 

Can you give more details ?

[Sideshow-Cad]

I know divide can be used to plot points or blocks along a poly line. But I am wanting to plot straight lines from one poly line at their maximum length before they touch the 2nd poly line along certain intervals of poly line 1.

 

E.g imagine you are driving along in your car along poly line 1. There is a concrete barrier in the central reservation along the route (poly line 2) I want to plot your eyesight from your car (polyline 1) to how far you can see in front of you before the Central reservation (polyline 2) blocks your view. I am wanting to do this at a number of intervals along an entire route.

 

Thanks.

 

Sorry if I am not explaining well.

[Tharwat]

It would be much clearer if you can prove your words into a drawing with BEFORE and AFTER

[Sideshow-Cad]

Example attached.

 

I would want to repeat the "stopping sight lines" along the entire route at specific intervals.

 

Notice how the lines are at their maximum length possible before touching polyline 2

eg.dwg

[BIGAL]

You want something like my "driveway" it checks for car bottoming out when entering a property, the sight distance though is a little more complicated when considered in the plan view. If you bring the 3d into it even more complicated. products like Autoturn have this function built in.

 

 

Your welcome to change this code it needs two things altered the distance 2.8 is the distance between the car wheel centres so this would need to be your stopping sight distance value and the block could be replaced with a line, you just manually look at it for conflicts. The code below is VBA I have been meaning to redo in Vlisp.

 

Sub draw_vehicle()

Dim CAR As String
Dim arcobj As AcadArc
Dim oPoly As AcadEntity
Dim blkobj As AcadEntity
Dim retVal As Variant
Dim snapPt As Variant
Dim oCoords As Variant
Dim blpnt1() As Variant
ReDim blpnt1(100)
Dim blpnt2() As Variant
ReDim blpnt2(100)
Dim vertPt(0 To 2) As Double
Dim Pt1(0 To 2) As Double
Dim Pt2(0 To 2) As Double
Dim newPt(0 To 2) As Double
Dim iCnt, w, x, y, z As Integer
Dim cRad, interval, blkangle As Double
Dim circObj As AcadCircle
Dim lineObj As AcadLine

On Error GoTo Something_Wrong

If ThisDrawing.ActiveSpace = acModelSpace Then
Set Thisspace = ThisDrawing.ModelSpace
Else: Set Thisspace = ThisDrawing.PaperSpace
End If

For Each Item In ThisDrawing.Blocks
If Item.Name = "holden" Then GoTo continue_on

Next Item
' insert holden block
InsertBlock "p:\Autodesk\vba\holdencar.dwg", 0

continue_on:

w = 1

ThisDrawing.Utility.GetEntity oPoly, snapPt, vbCr & "Select polyline :"
If oPoly.ObjectName = "AcDbPolyline" Then
oCoords = oPoly.Coordinates
Else: MsgBox "This object is not a polyline! Please do again"
Exit Sub
End If

interval = CDbl(InputBox("Enter interval:", , 1#))
If interval < 1 Then
interval = 1
End If

For iCnt = 0 To UBound(oCoords) - 2 Step 2
Pt1(0) = oCoords(iCnt): Pt1(1) = oCoords(iCnt + 1): Pt1(2) = 0#

newPt(0) = Pt1(0)
newPt(1) = Pt1(1)
newPt(2) = 0#

iCnt = iCnt + 2

Pt2(0) = oCoords(iCnt): Pt2(1) = oCoords(iCnt + 1): Pt2(2) = 0#

x = (Pt1(0) - Pt2(0)) / interval
y = (Pt1(1) - Pt2(1)) / interval

'reset back 2 values

iCnt = iCnt - 2
cRad = 3.05
startang = 4.71239

endang = 1.570796

CAR = "HOLDEN"

For z = 1 To interval
vertPt(0) = newPt(0) - x
vertPt(1) = newPt(1) - y
vertPt(2) = 0#
'blpnt1(w) = vertPt
'Set arcobj = ThisDrawing.ModelSpace.AddArc(vertPt, cRad, endang, startang)
Set arcobj = Thisspace.AddArc(vertPt, cRad, endang, startang)
retval2 = arcobj.IntersectWith(oPoly, acExtendOtherEntity)
arcobj.Delete
Set arcobj = Nothing

blkangle = ThisDrawing.Utility.AngleFromXAxis(retval2, vertPt)

'Set blkobj = ThisDrawing.ModelSpace.InsertBlock(vertPt, CAR, 1#, 1#, 1#, blkangle)
Set blkobj = Thisspace.InsertBlock(vertPt, CAR, 1#, 1#, 1#, blkangle)

Set blkobj = Nothing

w = w + 1

newPt(0) = newPt(0) - x
newPt(1) = newPt(1) - y

Next z

Next iCnt
GoTo Exit_out

Something_Wrong:
MsgBox Err.Description

Exit_out:

End Sub

Private Sub InsertBlock1()




   InsertBlock "p:\Autodesk\vbaholden.dwg", 0

   'Change the 0 to another value (in degrees) to rotate the block'



   End Sub

   Function InsertBlock(ByVal blockpath As String, ByVal rotation As Double)

   Dim blockobj As AcadBlockReference

   Dim insertionPnt As Variant

   Dim prompt1 As String

   'set rotation Angle

   rotateAngle = rotation

   'rotateAngle = rotation * 3.141592 / 180#

   'Prompt is used to show instructions in the command bar

   prompt1 = vbCrLf & "Enter block insert point: "
 
   'ThisDrawing.ActiveSpace = acModelSpace
 
   insertionPnt = ThisDrawing.Utility.GetPoint(, prompt1)

   Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, blockpath, 1#, 1#, 1#, rotateAngle)

   'Change Modelspace into Paperspace to insert the block into Paperspace
 
   End Function

 

[Sideshow-Cad]

BIGAL said:

You want something like my "driveway" it checks for car bottoming out when entering a property, the sight distance though is a little more complicated when considered in the plan view. If you bring the 3d into it even more complicated. products like Autoturn have this function built in.

 

[ATTACH=CONFIG]54704[/ATTACH]

 

Your welcome to change this code it needs two things altered the distance 2.8 is the distance between the car wheel centres so this would need to be your stopping sight distance value and the block could be replaced with a line, you just manually look at it for conflicts. The code below is VBA I have been meaning to redo in Vlisp.

 

Sub draw_vehicle()

Dim CAR As String
Dim arcobj As AcadArc
Dim oPoly As AcadEntity
Dim blkobj As AcadEntity
Dim retVal As Variant
Dim snapPt As Variant
Dim oCoords As Variant
Dim blpnt1() As Variant
ReDim blpnt1(100)
Dim blpnt2() As Variant
ReDim blpnt2(100)
Dim vertPt(0 To 2) As Double
Dim Pt1(0 To 2) As Double
Dim Pt2(0 To 2) As Double
Dim newPt(0 To 2) As Double
Dim iCnt, w, x, y, z As Integer
Dim cRad, interval, blkangle As Double
Dim circObj As AcadCircle
Dim lineObj As AcadLine

On Error GoTo Something_Wrong

If ThisDrawing.ActiveSpace = acModelSpace Then
Set Thisspace = ThisDrawing.ModelSpace
Else: Set Thisspace = ThisDrawing.PaperSpace
End If

For Each Item In ThisDrawing.Blocks
If Item.Name = "holden" Then GoTo continue_on

Next Item
' insert holden block
InsertBlock "p:\Autodesk\vba\holdencar.dwg", 0

continue_on:

w = 1

ThisDrawing.Utility.GetEntity oPoly, snapPt, vbCr & "Select polyline :"
If oPoly.ObjectName = "AcDbPolyline" Then
oCoords = oPoly.Coordinates
Else: MsgBox "This object is not a polyline! Please do again"
Exit Sub
End If

interval = CDbl(InputBox("Enter interval:", , 1#))
If interval < 1 Then
interval = 1
End If

For iCnt = 0 To UBound(oCoords) - 2 Step 2
Pt1(0) = oCoords(iCnt): Pt1(1) = oCoords(iCnt + 1): Pt1(2) = 0#

newPt(0) = Pt1(0)
newPt(1) = Pt1(1)
newPt(2) = 0#

iCnt = iCnt + 2

Pt2(0) = oCoords(iCnt): Pt2(1) = oCoords(iCnt + 1): Pt2(2) = 0#

x = (Pt1(0) - Pt2(0)) / interval
y = (Pt1(1) - Pt2(1)) / interval

'reset back 2 values

iCnt = iCnt - 2
cRad = 3.05
startang = 4.71239

endang = 1.570796

CAR = "HOLDEN"

For z = 1 To interval
vertPt(0) = newPt(0) - x
vertPt(1) = newPt(1) - y
vertPt(2) = 0#
'blpnt1(w) = vertPt
'Set arcobj = ThisDrawing.ModelSpace.AddArc(vertPt, cRad, endang, startang)
Set arcobj = Thisspace.AddArc(vertPt, cRad, endang, startang)
retval2 = arcobj.IntersectWith(oPoly, acExtendOtherEntity)
arcobj.Delete
Set arcobj = Nothing

blkangle = ThisDrawing.Utility.AngleFromXAxis(retval2, vertPt)

'Set blkobj = ThisDrawing.ModelSpace.InsertBlock(vertPt, CAR, 1#, 1#, 1#, blkangle)
Set blkobj = Thisspace.InsertBlock(vertPt, CAR, 1#, 1#, 1#, blkangle)

Set blkobj = Nothing

w = w + 1

newPt(0) = newPt(0) - x
newPt(1) = newPt(1) - y

Next z

Next iCnt
GoTo Exit_out

Something_Wrong:
MsgBox Err.Description

Exit_out:

End Sub

Private Sub InsertBlock1()




   InsertBlock "p:\Autodesk\vbaholden.dwg", 0

   'Change the 0 to another value (in degrees) to rotate the block'



   End Sub

   Function InsertBlock(ByVal blockpath As String, ByVal rotation As Double)

   Dim blockobj As AcadBlockReference

   Dim insertionPnt As Variant

   Dim prompt1 As String

   'set rotation Angle

   rotateAngle = rotation

   'rotateAngle = rotation * 3.141592 / 180#

   'Prompt is used to show instructions in the command bar

   prompt1 = vbCrLf & "Enter block insert point: "
 
   'ThisDrawing.ActiveSpace = acModelSpace
 
   insertionPnt = ThisDrawing.Utility.GetPoint(, prompt1)

   Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, blockpath, 1#, 1#, 1#, rotateAngle)

   'Change Modelspace into Paperspace to insert the block into Paperspace
 
   End Function

 

 

[ATTACH=CONFIG]54705[/ATTACH]

 

Could anyone please edit the above ^^^ or the following: (to help me reach my desired output?)

(defun c:pso ( / cl1 cl2 d pt pt2 templine ang spc )

;;; pBe 30Aug2014 ;;;

(if (and

(princ "\nSelect the main alignment")

(setq cl1 (ssget "_:S" '((0 . "*POLYLINE"))))

(princ "\nSelect the offset alignment")

(setq cl2 (ssget "_:S" '((0 . "*POLYLINE"))))

)

(progn

(setq d (cond ((getdist

(strcat "\nEnter increment value: " "

(cond ( d_ ) ( 100.00 ))

) 2 2) ">: ")))

( d )

)

)

(setq cl1 (ssname cl1 0)

cl2 (ssname cl2 0) d_ d)

(while (setq pt (vlax-curve-getpointatdist cl1 d))

(setq ang (angle '(0.0 0.0 0.0)

(vlax-curve-getfirstderiv

cl1

(vlax-curve-getparamatpoint cl1 pt)

)

)

)

(setq templine (vlax-invoke (setq spc (vlax-get

(vla-get-ActiveLayout

(vla-get-ActiveDocument (vlax-get-acad-object )))

'Block)) 'AddXline pt

(polar pt (setq ang (+ ang (* pi 1.5))) 1))

)

(if (setq pt2 (vlax-invoke

templine

'IntersectWith

(vlax-ename->vla-object cl2)

0

)

)

(vlax-invoke spc 'Addline pt (list (Car pt2)(cadr pt2)(caddr pt2)))

)

(vla-delete templine)

(setq d (+ d d_))

)

)

)

(princ)

)

(vl-load-com)

 

 

 

Thank you for any help in advance

[BIGAL]

Have a look at this link http://advancedroaddesign.com.au/ a new version is only a week or 2 away and has stopping site distance as part of it, check in full 3d for various speeds etc. Is it main road is it side road ? Go to the more button.

[Organic]

Personally I would be manually checking the sight distance. It is a fairly easy task to do relative to the amount of roadworks you are designing.