LISP : Fixed Length Line between 2 Polylines at Fixed offsets

[rob.gill688864]

Hi All,

Apologies if this has been requested before but I am struggling to find a solution. I was hoping to find a .lisp that can assist me to carry out a vertical forward visibility check on a carriageway alignment that I have in CAD.

In essence I am looking for a lisp to draw a line of a predetermined length between polyline A and polyline B at predetermined intervals across the full length of polyline A.

http://forums.augi.com/attachment.php?attachmentid=98848&stc=1

The above image/attachement attempts to capture what I am trying to say. Hopefully it helps.

Thanks in advance for your help on this, I greatly appreciate it.

Rob.

[peter]

OK, Looks doable.

Do you have a drawing that I could look at?

How do you define the start point on Green line and the direction to the second point on blue line?

Is the blue line an offset of the green line?

P=

Peter

[peter]

Lets start with faceting the primary polyline.

This code will trace the selected pline with a faceted pline with facets at a specified length.

It can facet from either end of a pline.

The code you have asked for is similar...

But this code has the steps, it just requires tweaking it to do what you want.

P=




;___________________________________________________________________________________________________________
;
; Function to facet a polyline with a specified length of straight edges.
; Written By: Peter Jamtgaard 2015 All rights reserved
;___________________________________________________________________________________________________________

(defun C:Facet1 (/ lstIntersections lstPoint lstPoint1 objCircle sngDirection sngRadius ssPolyline1 )
(setvar "cmdecho" 0)
(and
(print "Select Polyline 1: ")
(setq ssPolyline1 (ssget ":S:E" (list (cons 0 "*POLYLINE"))))
(setq lstPoint1 (cadr (grread 1)))

(setq objPolyline1 (vlax-ename->vla-object (ssname ssPolyline1 0)))

(setq lstPoint1 (polylineendpoint objPolyline1 lstPoint1))


(vl-cmdf "circle" lstPoint1)

(print "Select or enter diameter of circle (spacing on primary polyline): ")
(vl-cmdf pause)

(setq objCircle1 (vlax-ename->vla-object (entlast)))
(= (vla-get-objectname objCircle1) "AcDbCircle")

(setq sngRadius (vla-get-radius objCircle1))
(setq lstIntersections (intersections objPolyline1 objCircle1))
(setq sngDirection (Direction objPolyline1 lstPoint1 (car lstIntersections)))

(vl-cmdf "pline" lstPoint1)
(while (setq lstPoint (PointNext objPolyline1 objCircle1 sngDirection))

(vl-cmdf lstPoint)
;(getstring "Press Enter")
)
(vl-cmdf "")
)


)
;___________________________________________________________________________________________________________
;
; Function to find the param of the next intersection between circle and polyline.
; in the direction of the "sngDirection" (1 or -1) and moves the circle to the next
; point.
;___________________________________________________________________________________________________________

(defun PointNext (objPolyline objCircle sngDirection / lstPoint sngParam)
(print "Pointnext")
(if (and
(setq sngParam (paramcompare objPolyline objCircle sngDirection))
(setq lstPoint (vlax-curve-getpointatparam objPolyline
sngParam))
(errortrap (quote (vlax-put objCircle "center" lstPoint)))
)
lstPoint
)
)

;___________________________________________________________________________________________________________
;
; Function to compare parameters
; The Circle crosses the polyline in two places typically.
; This function determines calls the param function and determines which one is in the right direction.
;___________________________________________________________________________________________________________

(defun ParamCompare (objPolyline objCircle sngDirection / lstParams sngCenterpoint)
(setq sngCenterParam (vlax-curve-getparamatpoint objPolyline (vlax-get objCircle "Center")))
(setq lstParams (params objPolyline objCircle))
(if (= (/ (- (car lstParams) sngCenterParam)
(abs(- (car lstParams) sngCenterParam))
)
sngDirection
)
(car lstParams)
(cadr lstParams)
)
)
;___________________________________________________________________________________________________________
;
; This function determines which direction the next point is.
;___________________________________________________________________________________________________________

(defun Direction (objPolyline lstPoint1 lstPoint2 / sngDelta)
(setq sngDelta (- (vlax-curve-getparamatpoint objPolyline lstPoint2)
(vlax-curve-getparamatpoint objPolyline lstPoint1)
)
)
(/ sngDelta (abs sngDelta))
)

;___________________________________________________________________________________________________________
;
; This function determines the which end of the pline is closest to the pick point to select pline.
;___________________________________________________________________________________________________________

(defun PolylineEndPoint (objPolyline lstPoint / lstPointEnd lstPointStart)
(if (and
(setq lstPointEnd (vlax-curve-getpointatparam objPolyline (vlax-curve-getendparam objPolyline)))
(setq lstPointStart (vlax-curve-getpointatparam objPolyline 0.0))
)
(if (< (distance lstPoint lstPointEnd)
(distance lstPoint lstPointStart)
)
lstPointEnd
lstPointStart
)
)
)

;___________________________________________________________________________________________________________
;
; Function to determine the intersections of the circle and pline using intersectwith method,
;___________________________________________________________________________________________________________

(defun Intersections (objPolyline objCircle / lstIntersections lstPoints safIntesections varIntersections)

(if (and
(setq varIntersections (vla-intersectwith objPolyline objCircle 0))
(setq safIntersections (vlax-variant-value varIntersections))
(setq lstIntersections (vlax-safearray->list safIntersections))
(> (length lstIntersections) 0)
(setq lstPoints (parse lstIntersections 3))
)
lstPoints
)
)

;___________________________________________________________________________________________________________
;
; Function to convert a list of points on a pline to a list of param's.
;___________________________________________________________________________________________________________

(defun Params (objPolyline objCircle)
(mapcar '(lambda (X)(vlax-curve-getparamatpoint objPolyline X))
(intersections objPolyline objCircle)
)
)

;___________________________________________________________________________________________________________
;
; Function to parse a list of coordinates like '(1.0 2.0 3.0 4.0 5.0 6.0) to '((1.0 2.0 3.0)(4.0 5.0 6.0))
;___________________________________________________________________________________________________________

(defun Parse (lstCoordinates intNumber / lstPoint lstPoints)
(repeat (fix (/ (length lstCoordinates) intNumber))
(setq lstPoint nil)
(repeat intNumber
(setq lstPoint (cons (car lstCoordinates) lstPoint)
lstCoordinates (cdr lstCoordinates)
)
)
(setq lstPoints (cons (reverse lstPoint) lstPoints))
)
(reverse lstPoints)
)

;___________________________________________________________________________________________________________
;
; Function to trap lisp errors
;___________________________________________________________________________________________________________

(defun ErrorTrap (symFunction / objError result)
(if debugUtil (princ "\nNRGtoolbox_nrgx:Errortrap : "))
(if (vl-catch-all-error-p
(setq objError (vl-catch-all-apply
'(lambda (X123)(set X123 (eval symFunction)))
(list 'result))))
nil
(if result result 'T)
)
)

(vl-load-com)

[rob.gill688864]

Hi Peter,

Thank you for taking the time to look at this problem for me. The 2 (Green and Blue) polylines are simply offset from on another. I have a lisp that I use to draw cords (fixed length at specified offsets) along a single polyline which is extremely useful (attached, although it is buggy now as the prompt command doesn't work, but still works). I have tried to edit this lisp (unsuccessfully as I am not very good at looking at code) to make it target a second polyline rather than itself. Maybe you or someone else will have some better success.

Thanks again for your help.

Rob

[peter]

The facet1.lsp draws chords like the program you attached above.

I am familiar with how my routine (which I just wrote) works.

It is not that difficult to do what you want with the code I developed.

P=

[Bruno.Valsecchi]

Hello, i don't know what you want to make! but the original code is it:


(vl-load-com)
(defun c:epure-masque_lateral ( / js ldat vlaobj perim_obj pt_start pt_end d_x lst_pt pt_last inc vref rad pt pt_int e_last env_mask)
(princ (strcat"\nSélectionner l'objet représentant le bord de la bande de rive de la chaussée."))
(while
(not
(setq js
(ssget "_+.:E:S"
(list
(cons 0 "*POLYLINE,ARC,SPLINE")
(cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
(cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
(cons -4 "<NOT")
(cons -4 "&") (cons 70 113) ;(70 . 121)
(cons -4 "NOT>")
)
)
)
)
)
(setq
ldat '((20 . 15.5)(30 . 26.5)(40 . 40.0)(50 . 55.0)(60 . 72.0)(70 . 95.0)(80 . 121.0)(90 . 151.0)(100 . 187.0))
vlaobj (vlax-ename->vla-object (ssname js 0))
perim_obj (vlax-curve-getDistAtParam vlaobj (vlax-curve-getEndParam vlaobj))
pt_start (vlax-curve-getStartPoint vlaobj)
pt_end (vlax-curve-getEndPoint vlaobj)
d_x 0.0
lst_pt nil
pt_last nil
env_mask (list pt_end)
inc perim_obj
)
(initget "20 30 40 50 60 70 80 90 100")
(setq vref (getkword "\nVitesse de référence en Km/h de la voie? [20/30/40/50/60/70/80/90/100]<90>: "))
(if (not vref) (setq vref "90"))
(setq rad (cdr (assoc (read vref) ldat)))
(if (>= rad perim_obj) (progn (princ "\nLa distance de visibilité excède la longueur de la bande de rive sélectionnée!") (exit)))
(while (>= inc perim_obj)
(initget 6)
(setq inc (getdist (strcat "\nEquidistance de résolution? <" (rtos (/ rad 10.0)) ">: ")))
(if (not inc) (setq inc (/ rad 10.0)))
(if (>= inc perim_obj) (princ "\nLa distance de résolution de l'épure excède la longueur de la bande de rive sélectionnée!"))
)
(while (< d_x perim_obj)
(setq
lst_pt (cons (vlax-curve-getPointAtDist vlaobj d_x) lst_pt)
d_x (+ d_x inc)
)
)
(while lst_pt
(entmake
(append
'(
(0 . "CIRCLE")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "degagement-visibilite-lateral")
(60 . 1)
(62 . 256)
(6 . "ByLayer")
(370 . -2)
(100 . "AcDbCircle")
)
(list (cons 40 rad))
(list (cons 10 (car lst_pt)))
'((210 0.0 0.0 1.0))
)
)
(setq pt (vlax-invoke vlaobj 'IntersectWith (vlax-ename->vla-object (entlast)) acExtendNone))
(if (and pt pt_last (> (length pt) 3))
(if (> (distance (list (car pt) (cadr pt) (caddr pt)) pt_last) (distance (list (cadddr pt) (car (cddddr pt)) (last pt)) pt_last))
(setq pt (list (cadddr pt) (car (cddddr pt)) (last pt)))
(setq pt (list (car pt) (cadr pt) (caddr pt)))
)
)
(entdel (entlast))
(if (and pt (<(length pt) 4))
(progn
(entmake
(append
'(
(0 . "LINE")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "degagement-visibilite-lateral")
(62 . 9)
(6 . "ByLayer")
(370 . -2)
(100 . "AcDbLine")
)
(list (cons 10 (car lst_pt)))
(list (cons 11 pt))
'((210 0.0 0.0 1.0))
)
)
(if e_last
(progn
(setq pt_int (vlax-invoke (vlax-ename->vla-object e_last) 'IntersectWith (vlax-ename->vla-object (entlast)) acExtendNone))
(if pt_int (setq env_mask (cons pt_int env_mask)))
)
)
(setq e_last (entlast))
)
(setq pt nil)
)
(setq lst_pt (cdr lst_pt) pt_last pt)
)
(setq env_mask (mapcar '(lambda (x) (list 10 (car x) (cadr x))) (reverse (cons pt_start env_mask))))
(entmake
(append
'(
(0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "degagement-visibilite-lateral")
(62 . 3)
(6 . "ByLayer")
(370 . -2)
(100 . "AcDbPolyline")
)
(list (cons 90 (length env_mask)))
'((70 . 0))
(apply 'append (mapcar '(lambda (x10) (append (list x10 '(40 . 0.0) '(41 . 0.0) '(42 . 0.0)))) env_mask))
'((210 0.0 0.0 1.0))
)
)
(prin1)
)


code in french publied here (http://cadxp.com/topic/25850-degagement-de-visibilite-laterale/page__p__140956__hl__epure-masque_lateral__fromsearch__1#entry140956)

[rob.gill688864]

The facet1.lsp draws chords like the program you attached above.

I am familiar with how my routine (which I just wrote) works.

It is not that difficult to do what you want with the code I developed.

P=

Hi Peter,

Thank you for the facet1.lsp. Apologies if I have offended you. It was not intended.

The problem is that I no coding ability and hence the reason I have asked people like you, who clearly have, to help if you can.

[rob.gill688864]

Hello, i don't know what you want to make! but the original code is

Thank you for this Btw!

[peter]

Try this.

P=



;___________________________________________________________________________________________________________
;
; Function to draw lines between two adjacent polylines as specific radius from base points.
; Written By: Peter Jamtgaard 2015 All rights reserved
;___________________________________________________________________________________________________________

(defun C:Facet2 (/ lstIntersections1
lstIntersections2
lstPoint
lstPoint1
lstPoint2
objCircle1
objCircle2
objPolyline1
objPolyline2
sngDirection
ssPolyline1
ssPolyline2
)
(setvar "cmdecho" 0)
(and
(print "Select Polyline 1: ")
(setq ssPolyline1 (ssget ":S:E" (list (cons 0 "*POLYLINE"))))
(setq lstPoint1 (cadr (grread 1)))
(setq objPolyline1 (vlax-ename->vla-object (ssname ssPolyline1 0)))
(setq lstPoint (polylineendpoint objPolyline1 lstPoint1))

(print "Select Polyline 2: ")
(setq ssPolyline2 (ssget ":S:E" (list (cons 0 "*POLYLINE"))))
(setq objPolyline2 (vlax-ename->vla-object (ssname ssPolyline2 0)))

(vl-cmdf "circle" lstPoint)

(print "Select or enter diameter of circle (spacing on primary polyline): ")
(vl-cmdf pause)

(setq objCircle1 (vlax-ename->vla-object (entlast)))

(= (vla-get-objectname objCircle1) "AcDbCircle")

(vl-cmdf "circle" lstPoint)
(print "Select or enter diameter of circle (spacing on secondary polyline): ")
(vl-cmdf pause)

(setq objCircle2 (vlax-ename->vla-object (entlast)))

(= (vla-get-objectname objCircle2) "AcDbCircle")

(setq lstIntersections1 (intersections objPolyline1 objCircle1))
(print lstIntersections1)

(setq lstIntersections2 (intersections objPolyline2 objCircle2))
(print lstIntersections2)

(setq sngDirection1 (Direction objPolyline1 lstPoint (car lstIntersections1)))
(print sngDirection1)

(while (and (setq lstPoint1 (PointNext objPolyline1 objCircle1 sngDirection1))
(setq lstPoint2 (PointNext objPolyline2 objCircle2 sngDirection1))
)
(vl-cmdf "line" lstPoint lstPoint2 "")
(getstring "Press Enter")
(errortrap (quote (vlax-put objCircle1 "center" lstPoint1)))
(errortrap (quote (vlax-put objCircle2 "center" lstPoint1)))
(setq lstPoint lstPoint1)

)
)
)
;___________________________________________________________________________________________________________
;
; Function to find the param of the next intersection between circle and polyline.
; in the direction of the "sngDirection" (1 or -1) and moves the circle to the next
; point.
;___________________________________________________________________________________________________________

(defun PointNext (objPolyline objCircle sngDirection / lstPoint sngParam)
(print "Pointnext")
(if (and
(setq sngParam (paramcompare objPolyline objCircle sngDirection))
(setq lstPoint (vlax-curve-getpointatparam objPolyline
sngParam))

)
lstPoint
)
)

;___________________________________________________________________________________________________________
;
; Function to compare parameters
; The Circle crosses the polyline in two places typically.
; This function determines calls the param function and determines which one is in the right direction.
;___________________________________________________________________________________________________________

(defun ParamCompare (objPolyline objCircle sngDirection / lstParams sngCenterpoint)
(setq sngCenterParam (vlax-curve-getparamatpoint objPolyline
(vlax-curve-getclosestpointto objPolyline
(vlax-get objCircle "Center") 0)))
(setq lstParams (params objPolyline objCircle))
(if (= (/ (- (car lstParams) sngCenterParam)
(abs(- (car lstParams) sngCenterParam))
)
sngDirection
)
(car lstParams)
(cadr lstParams)
)
)
;___________________________________________________________________________________________________________
;
; This function determines which direction the next point is.
;___________________________________________________________________________________________________________

(defun Direction (objPolyline lstPoint1 lstPoint2 / sngDelta)
(setq sngDelta (- (vlax-curve-getparamatpoint objPolyline lstPoint2)
(vlax-curve-getparamatpoint objPolyline lstPoint1)
)
)
(/ sngDelta (abs sngDelta))
)

;___________________________________________________________________________________________________________
;
; This function determines the which end of the pline is closest to the pick point to select pline.
;___________________________________________________________________________________________________________

(defun PolylineEndPoint (objPolyline lstPoint / lstPointEnd lstPointStart)
(if (and
(setq lstPointEnd (vlax-curve-getpointatparam objPolyline (vlax-curve-getendparam objPolyline)))
(setq lstPointStart (vlax-curve-getpointatparam objPolyline 0.0))
)
(if (< (distance lstPoint lstPointEnd)
(distance lstPoint lstPointStart)
)
lstPointEnd
lstPointStart
)
)
)

;___________________________________________________________________________________________________________
;
; Function to determine the intersections of the circle and pline using intersectwith method,
;___________________________________________________________________________________________________________

(defun Intersections (objPolyline objCircle / lstIntersections lstPoints safIntesections varIntersections)

(if (and
(setq varIntersections (vla-intersectwith objPolyline objCircle 0))
(setq safIntersections (vlax-variant-value varIntersections))
(setq lstIntersections (vlax-safearray->list safIntersections))
(> (length lstIntersections) 0)
(setq lstPoints (parse lstIntersections 3))
)
lstPoints
)
)

;___________________________________________________________________________________________________________
;
; Function to convert a list of points on a pline to a list of param's.
;___________________________________________________________________________________________________________

(defun Params (objPolyline objCircle)
(mapcar '(lambda (X)(vlax-curve-getparamatpoint objPolyline X))
(intersections objPolyline objCircle)
)
)

;___________________________________________________________________________________________________________
;
; Function to parse a list of coordinates like '(1.0 2.0 3.0 4.0 5.0 6.0) to '((1.0 2.0 3.0)(4.0 5.0 6.0))
;___________________________________________________________________________________________________________

(defun Parse (lstCoordinates intNumber / lstPoint lstPoints)
(repeat (fix (/ (length lstCoordinates) intNumber))
(setq lstPoint nil)
(repeat intNumber
(setq lstPoint (cons (car lstCoordinates) lstPoint)
lstCoordinates (cdr lstCoordinates)
)
)
(setq lstPoints (cons (reverse lstPoint) lstPoints))
)
(reverse lstPoints)
)

;___________________________________________________________________________________________________________
;
; Function to trap lisp errors
;___________________________________________________________________________________________________________

(defun ErrorTrap (symFunction / objError result)
(if debugUtil (princ "\nNRGtoolbox_nrgx:Errortrap : "))
(if (vl-catch-all-error-p
(setq objError (vl-catch-all-apply
'(lambda (X123)(set X123 (eval symFunction)))
(list 'result))))
nil
(if result result 'T)
)
)

(vl-load-com)

[rob.gill688864]

Thank you Peter!!

That worked fantastically. Thank you so much!

I have another request but will start a new thread as I am sure it will help people who search for these lisps to find.

thanks again.

[ddavies700661]

Hi and let me first say that I am new to the forms and have just started in the world of LISP's but I was wondering if there would be a way to advance this tool for a totally different yet related problem. This command allows us to determine the center line between two polylines; what if I wanted several lnes between two polylines that were equally spaced. Essentially if I have the 10' contour and 15' contour line with a varying slope between those two lines I would be able to generate the 11-14 contours via the same command as above. Let me know if this makes any sense I would be happy to provide an example of what I am looking for if this is confusing. Thanks ahead of your replies for help with this if you're so inclined to do so.

[peter]

Do you have an algorithm even verbally to calculate the midpoint between two contours.

I played around with it, but contours may be of difference length so how do you estimate the two points on the two contours to find the midpoint?

P=

[ddavies700661]

Hm, That is really tough, I was thinking of something like this; feel free to let me know that this is just ridiculous, I wouldnt be suprised.

If you were able to take your previous LISP and add a conditional "if" statement (assuming its easy to differentiate between line and arc segments of a polyline) for arcs then you could take the beginning and end points and run your LISP to find the beginning and end portions of the arc, then use the midpoint radius of the two arcs to calculate the difference (A+B/2) to generate the radius for the generate arc segment of the polyline.

The litmus test to see if this would work would be to have a a line ____^____ and mirror it a distance away and see if it were to generate a straight line in between the two. If Arc Segment "A" had a -10' Radii and Arc Segment B had a 10' radii, then it should generate a polyline arc with a radii of 0.

That is for two lines and generating one arc in between. For generating a multiple infill of say 4 lines between, again we could start with your LISP but modify it with the MEASURE command so that we can generate multiple points along the endpoint segments and would follow that routine for straight lines, and for arcs, depending on the number of intermediate contours (lets go with 4... assuming Contour Polyine A and Contour Polyline B are the 5' and 10' contours respectively.) To generate the radii for those contours they should follow the same principle of increasing on their way towards the higher radii arc. so if we had a radii of 2' on the 5' Contour Polyline A and 12' on Contour Polyline B then the intermediate contours should be of the intermediate values of 4', 6', 8', and 10'.

I think this makes sense? No clue if it can be done. IT might be easier to think of this not as contours but essentially as generating polylines with arc segments at measured distances between two polylines.

[ddavies700661]

My last post got deleted while trying to attach a dwg so here is a more condensed version. I assume I need to be "pro" or "advanced" to send a dwg but let me know if you want me to email it or something. Heres my idea:

Could you begin the arc command where the endpoint of the polyline line segment (where the arc's begin on the two beginning contour polylines) and begin the arc command and pull an additional connecting line at the midpoint of the two arcs and use the center or second point of the arc command to generate an arc versus a line. Alternatively, could you just pull endpoints and midpoint connecting lines and arcs and where there are arcs begin the arc command?

This makes much more sense in my dwg but still not sure if it can even work...

Thank you for taking the time to dig into this!

[peter]

You can post drawings

Use the go advanced button and below you will see the manage attachment button.

The the add files in the upper right corner of that window

The I click the basic uploader and the browse button.

P=