Lisp to create polyline between polylines

[makdak]

Hi, i need a lisp to create a polyline that runs between two given polylines, any idea how this can be done? Thanks in advance!

[Lee Mac]

Welcome to CADTutor Makdak,

 

Could you possibly explain a little more about how the polyline should run between the other two? Are we talking just straight lines? Is the extra polyline perpendicular to the other two?

 

Lee

[makdak]

Umm, no, the given polylines are not necessarily straight. I just want a polyline, each point of which has the same distance from the 2 given polylines. This, of course, would work with straight lines too since it is a more general approach. I'm not sure if i can explain it right because my english is not that great

[makdak]

To make it more clear, i have 2 polylines that represent the banks of a river and a want to create a polyline from those two, that would represent the axis of the river.. Hope that makes it a little more clear

[Lee Mac]

Ok, I think I understand, something like this:

 

 

Where the red polyline is the new one.

 

This would not of course be 100% accurate, as there would have to be a "sampling" of the polyline at intervals along its length.

[makdak]

Extactly! Yes, i know what you mean but that's not a really big problem. I guess i will figure a way to get to the desired accuracy. Do you know any ways to create such a polyline? Oh, and thanks for your interest Lee!

[Lee Mac]

Try this dude:

 

(defun c:cPoly (/ ent1 ent2 i len pt p1 ptlst)
 (vl-load-com)

 (if (and (setq ent1 (car (entsel "\nSelect First Polyline: ")))
          (wcmatch (cdr (assoc 0 (entget ent1))) "*POLYLINE"))
   (if (and (setq ent2 (car (entsel "\nSelect Second Polyline: ")))
            (wcmatch (cdr (assoc 0 (entget ent2))) "*POLYLINE"))
     (progn
       (setq i -1 len (/ (vla-get-Length
                           (vlax-ename->vla-object ent1)) 100.))
       (while (setq pt (vlax-curve-getPointatDist ent1 (* (setq i (1+ i)) len)))
         (setq p1 (vlax-curve-getClosestPointto ent2 pt t)
               ptlst (cons (polar pt (angle pt p1) (/ (distance pt p1) 2.)) ptlst)))
       (setq ptlst (apply 'append
                     (mapcar
                       (function
                         (lambda (x)
                           (list (car x) (cadr x)))) ptlst)))
       (vla-AddLightWeightPolyline
         (vla-get-ModelSpace
           (vla-get-ActiveDocument
             (vlax-get-acad-object)))
         (vlax-make-variant
           (vlax-safearray-fill
             (vlax-make-safearray
               vlax-VBDouble (cons 0 (1- (length ptlst)))) ptlst))))))

 (princ))

[makdak]

Works pretty well Lee, thanks so much!!

[Lee Mac]

Works pretty well Lee, thanks so much!!

 

No problem

[jaiganesh]

I think you better try "Rolling_ball.lsp" from JefferyPSanders.com, which might give u a more accurate "spine". This works on the "Rolling ball" theorum, which goes like this (in AutoCAD lingo):

The spine (or axis) of two polylines, is the path traced by the centre of a rolling circle which sits on the first circle at all points, which can expand till it touches the second polyline.

Basically it is like this: Take the endpoint on the first polyline, draw a circle that is tangential to the 1st polyline at that point and increase its dia till it touches the second polyline, Mark its center, Proceed to the next point on the first polyline and so on.

 

Hope this helps.

[makdak]

Yes, you're right, that seems to be much more accurate, in theory at least.

[Lee Mac]

My code is functioning in exactly the same way as the Rolling Ball theory - except my code is about 1/100th of the size..

 

I take a point at x distance along the polyline, and find the corresponding point perpendicular on the other polyline, then find the point that is mid-way between them.

[ronjonp]

My code is functioning in exactly the same way as the Rolling Ball theory - except my code is about 1/100th of the size..

 

I take a point at x distance along the polyline, and find the corresponding point perpendicular on the other polyline, then find the point that is mid-way between them.

 

This is the way I do it too

[Lee Mac]

This is the way I do it too

 

Thanks Ron :wink:

 

If you do not want as many vertices on the resultant polyline - just change this in my code to a lower number:

 

(setq i -1 len (/ (vla-get-Length
                   (vlax-ename->vla-object ent1)) [b][color=Red]100.[/color][/b]))

[Lee Mac]

Had a bit of time, so heres an animated version

 

 

 

(defun c:cPoly (/ ent1 ent2 i j mPt len pt p1 ptlst grlst grlin)
(vl-load-com)

(if (and (setq ent1 (car (entsel "\nSelect First Polyline: ")))
(wcmatch (cdr (assoc 0 (entget ent1))) "*POLYLINE"))
(if (and (setq ent2 (car (entsel "\nSelect Second Polyline: ")))
(wcmatch (cdr (assoc 0 (entget ent2))) "*POLYLINE"))
(progn
(setq i -1 len (/ (vla-get-Length
(vlax-ename->vla-object ent1)) 100.) grlin '( ))
(while (and (grread 't)
(setq pt (vlax-curve-getPointatDist ent1 (* (setq i (1+ i)) len))))
(redraw)
(setq p1 (vlax-curve-getClosestPointto ent2 pt t)
ptlst (cons
(setq mPt
(polar pt (angle pt p1) (/ (distance pt p1) 2.))) ptlst) j -1 grlst nil)
(repeat 500
(setq grlst
(cons
(polar mPt (* (setq j (1+ j)) (/ pi 250.)) (distance mPt p1)) grlst)))
(setq grlin (append grlin (list (if grlin (last grlin) mPt) mPt)))
(grvecs (append '(3) grlst (cdr grlst) (list (car grlst))))
(grvecs (append '(1) grlin)))
(redraw)
(setq ptlst (apply 'append
(mapcar
(function
(lambda (x)
(list (car x) (cadr x)))) ptlst)))
(vla-AddLightWeightPolyline
(vla-get-ModelSpace
(vla-get-ActiveDocument
(vlax-get-acad-object)))
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-VBDouble (cons 0 (1- (length ptlst)))) ptlst))))))

(princ))

 

 

Enjoy!

 

Lee

[lpseifert]

That's cool Lee... why do you need to keep the cursor moving? Is it one of those (gr things?

[Lee Mac]

That's cool Lee... why do you need to keep the cursor moving? Is it one of those (gr things?

 

Yes - works on a GrRead loop - only way to animate without using the "DELAY" command - which I don't like :wink:

[lpseifert]

which I don't like

Well I like it... thanks

[Lee Mac]

Well I like it... thanks

 

Thanks Larry

[alanjt]

LoL

I wish I had 1/10th the free time you have.

 

Nice work Lee.