Extend/Trim Polygon to Line

[PFHeller]

So I have these standard rectangles....ortho sides all around. They represent wall sections. There will be a slanted line running above them or through them that represents the ground. For each top vertice of the rectangles, I need to move them up or down to hit the ground line. I’d like to create a lisp routine that would allow me to select all of the rectangles, select the ground line, and have all the rectangle top vertices move straight up or down to hit the line. 

So here is my strategy, let me know if it is possible:

1. Select all rectangles, put them in a list.

2. Select ground line.

3. For each rectangle, find the point orthogonally above or below each top vertice that intersects the ground line. (This is the main part I need help with....no idea how to do this....I know how to get the vertices from the rectangle.....but to project a line....not sure)

4. Move each top vertices of the rectangle to the endpoint of the projected lines. Rinse and repeat for each rectangle.

If you have a idea to make the procedure better let me know....but especially if you have any ideas how to do that middle part....I’d be appreciative.

[CodeDing · Accepted solution]

@PFHeller ,

I can come back to help with this if needed, but use the INTERS function (be sure to use nil at the end!) with a second point directly above your rectangle point. In-essence:

(get rectangles)
(get ground line)
(turn off snaps)
(foreach point  in rectangle-points-determined
    (if (setq p (inters point (list (car point) (+ 1.0 (cadr point))) p1-on-groundline p2-on-groundline nil)
      p = your intersection point
      (move rectangle to point)
    ;else
    (no intersection point)
    );if
);foreach
(restore snaps)
;done

best,

~DD

[Sea-Haven]

You may want to look at the VL Intersectwith method this will give the intersection point co-ords can then look at the xY values of the rectang and move, its a bit more robust than Inters. sample code [code] (setvar "osmode" 512) ; nearest make sure on line (setq pickobj (entsel "\nPick arc :")) (setq obj1 (vlax-ename->vla-object (car pickobj))) (setq pt1 (cadr pickobj)) (setvar "clayer" (cdr (assoc 8 (entget (car pickobj))))) (setq pickobj1 (entsel "\nPick 1st line :")) (setq obj2 (vlax-ename->vla-object (car pickobj1))) (setq intpt1 (vlax-invoke obj2 'intersectWith obj1 acExtendThisEntity)) [/code]

[Kent1Cooper]

It seems to me the "accepted solution" in Message 2 is, while a good starting concept, pretty far from a solution.  The big issue I see is that it will find an actual or extended intersection for every corner  of the rectangle, but you don't want to move all four corners.  It needs something to determine whether a given corner is the upper  one on its side, and reposition it only if it is, leaving the lower corner on each side in place.

And the suggestion in Message 3 of the (...intersectwith…) method will work only if the ground Line passes through the rectangle.  It can't help you if it passes above.  With a closed  Polyline rectangle, it can't find the virtual intersection of an extension of an edge with another Line--it can virtually extend only open-ended objects.  Also, if the Line does go through the rectangle, it will find two  intersections, so there will need to be something to determine on which side of the rectangle each one is, and then which corner is the upper one to be repositioned.

Not that these things can't be done, but there's work to do before the problem will be solved.

[PFHeller]

I was able to solve the problem in part by using the Inters code mentioned in the accepted solution.......I also used info I learned in this post:

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/manipulating-or-changing-polyline-ve...

which was posted by you Kent.....so thanks!

If anybody that has posted here is interested in the final product....let me know and i'll share it with you. I'm a journeyman programmer at best.....I mainly draft in Civil3D....but I do lisp enough to help myself out. I glean as much as I can from you experts and then craft my not so elegant but useful solutions. 😃

[Anonymous]

PFHeller could you share this lisp with me? It sounds similar to what I'm looking for. I need a command that will extend a rectangle to a line/polyline. 

[PFHeller]

;;;This LISP routine is designed to project rectangles to intersect with a line.

(vl-load-com)

(defun c:PJR (/ )
(defun vpt (n) (vlax-curve-getPointAtParam Rectangle n))
(defun vptln (n) (vlax-curve-getPointAtParam UpperRectangle n))

(defun lrptr () ;find top right vertice
(setq TestPoint (list 2000000 2000000 0))

(if (< (distance (vpt 0) TestPoint) (distance (vpt 1) TestPoint))
(if (< (distance (vpt 0) TestPoint) (distance (vpt 2) TestPoint)) ; then if
(if (< (distance (vpt 0) TestPoint) (distance (vpt 3) TestPoint)) ; then if
(setq TopRightVertice 0) ;then vertice 0 is it
(setq TopRightVertice 3) ;else vertice 3 is it
) ;end if
(if (< (distance (vpt 2) TestPoint) (distance (vpt 3) TestPoint)) ; else if
(setq TopRightVertice 2) ;then vertice 2 is it
(setq TopRightVertice 3) ;else vertice 3 is it
) ;end if
) ; end if
(if (< (distance (vpt 1) TestPoint) (distance (vpt 2) TestPoint)) ; else if
(if (< (distance (vpt 1) TestPoint) (distance (vpt 3) TestPoint)) ; then if
(setq TopRightVertice 1) ;then vertice 1 is it
(setq TopRightVertice 3) ;else vertice 3 is it
) ;end if
(if (< (distance (vpt 2) TestPoint) (distance (vpt 3) TestPoint)) ; else if
(setq TopRightVertice 2) ;then vertice 2 is it
(setq TopRightVertice 3) ;else vertice 3 is it
) ;end if
) ; end if
) ; end if
) ; defun lrptr

(defun lrptl () ;find top left vertice
(setq TestPoint (list -2000000 2000000 0))

(if (< (distance (vpt 0) TestPoint) (distance (vpt 1) TestPoint))
(if (< (distance (vpt 0) TestPoint) (distance (vpt 2) TestPoint)) ; then if
(if (< (distance (vpt 0) TestPoint) (distance (vpt 3) TestPoint)) ; then if
(setq TopLeftVertice 0) ;then vertice 0 is it
(setq TopLeftVertice 3) ;else vertice 3 is it
) ;end if
(if (< (distance (vpt 2) TestPoint) (distance (vpt 3) TestPoint)) ; else if
(setq TopLeftVertice 2) ;then vertice 2 is it
(setq TopLeftVertice 3) ;else vertice 3 is it
) ;end if
) ; end if
(if (< (distance (vpt 1) TestPoint) (distance (vpt 2) TestPoint)) ; else if
(if (< (distance (vpt 1) TestPoint) (distance (vpt 3) TestPoint)) ; then if
(setq TopLeftVertice 1) ;then vertice 1 is it
(setq TopLeftVertice 3) ;else vertice 3 is it
) ;end if
(if (< (distance (vpt 2) TestPoint) (distance (vpt 3) TestPoint)) ; else if
(setq TopLeftVertice 2) ;then vertice 2 is it
(setq TopLeftVertice 3) ;else vertice 3 is it
) ;end if
) ; end if
) ; end if
) ; defun lrptl

(defun lrpbr () ;find bottom right vertice
(setq TestPoint (list 2000000 -2000000 0))

(if (< (distance (vpt 0) TestPoint) (distance (vpt 1) TestPoint))
(if (< (distance (vpt 0) TestPoint) (distance (vpt 2) TestPoint)) ; then if
(if (< (distance (vpt 0) TestPoint) (distance (vpt 3) TestPoint)) ; then if
(setq BottomRightVertice 0) ;then vertice 0 is it
(setq BottomRightVertice 3) ;else vertice 3 is it
) ;end if
(if (< (distance (vpt 2) TestPoint) (distance (vpt 3) TestPoint)) ; else if
(setq BottomRightVertice 2) ;then vertice 2 is it
(setq BottomRightVertice 3) ;else vertice 3 is it
) ;end if
) ; end if
(if (< (distance (vpt 1) TestPoint) (distance (vpt 2) TestPoint)) ; else if
(if (< (distance (vpt 1) TestPoint) (distance (vpt 3) TestPoint)) ; then if
(setq BottomRightVertice 1) ;then vertice 1 is it
(setq BottomRightVertice 3) ;else vertice 3 is it
) ;end if
(if (< (distance (vpt 2) TestPoint) (distance (vpt 3) TestPoint)) ; else if
(setq BottomRightVertice 2) ;then vertice 2 is it
(setq BottomRightVertice 3) ;else vertice 3 is it
) ;end if
) ; end if
) ; end if
) ; defun lrpbr

(defun lrpbl () ;find bottom left vertice
(setq TestPoint (list -2000000 -2000000 0))

(if (< (distance (vpt 0) TestPoint) (distance (vpt 1) TestPoint))
(if (< (distance (vpt 0) TestPoint) (distance (vpt 2) TestPoint)) ; then if
(if (< (distance (vpt 0) TestPoint) (distance (vpt 3) TestPoint)) ; then if
(setq BottomLeftVertice 0) ;then vertice 0 is it
(setq BottomLeftVertice 3) ;else vertice 3 is it
) ;end if
(if (< (distance (vpt 2) TestPoint) (distance (vpt 3) TestPoint)) ; else if
(setq BottomLeftVertice 2) ;then vertice 2 is it
(setq BottomLeftVertice 3) ;else vertice 3 is it
) ;end if
) ; end if
(if (< (distance (vpt 1) TestPoint) (distance (vpt 2) TestPoint)) ; else if
(if (< (distance (vpt 1) TestPoint) (distance (vpt 3) TestPoint)) ; then if
(setq BottomLeftVertice 1) ;then vertice 1 is it
(setq BottomLeftVertice 3) ;else vertice 3 is it
) ;end if
(if (< (distance (vpt 2) TestPoint) (distance (vpt 3) TestPoint)) ; else if
(setq BottomLeftVertice 2) ;then vertice 2 is it
(setq BottomLeftVertice 3) ;else vertice 3 is it
) ;end if
) ; end if
) ; end if
) ; defun lrpbl

(defun fndint () ;find intersection
(setq RectanglePointPlus (list (car RectanglePoint) (+ (cadr RectanglePoint) 1) (caddr RectanglePoint)))
(setq Temp (inters (vptln BottomLeftVerticeSet) (vptln BottomRightVerticeSet) (list (car RectanglePoint) (cadr RectanglePoint) (caddr RectanglePoint)) (list (car RectanglePointPlus) (cadr RectanglePointPlus) (caddr RectanglePointPlus)) nil))
(list (car Temp) (cadr Temp))
) ; defun

(defun swpcoords ();swapping the coordinates
(cond
((= TopLeftVertice 0)
(setq Coords (list (car TopLeftIntersection) (cadr TopLeftIntersection) (nth 2 Coords) (nth 3 Coords) (nth 4 Coords) (nth 5 Coords) (nth 6 Coords) (nth 7 Coords))))
((= TopLeftVertice 1)
(setq Coords (list (nth 0 Coords) (nth 1 Coords) (car TopLeftIntersection) (cadr TopLeftIntersection) (nth 4 Coords) (nth 5 Coords) (nth 6 Coords) (nth 7 Coords))))
((= TopLeftVertice 2)
(setq Coords (list (nth 0 Coords) (nth 1 Coords) (nth 2 Coords) (nth 3 Coords) (car TopLeftIntersection) (cadr TopLeftIntersection) (nth 6 Coords) (nth 7 Coords))))
((= TopLeftVertice 3)
(setq Coords (list (nth 0 Coords) (nth 1 Coords) (nth 2 Coords) (nth 3 Coords) (nth 4 Coords) (nth 5 Coords) (car TopLeftIntersection) (cadr TopLeftIntersection)))))
(cond
((= TopRightVertice 0)
(setq Coords (list (car TopRightIntersection) (cadr TopRightIntersection) (nth 2 Coords) (nth 3 Coords) (nth 4 Coords) (nth 5 Coords) (nth 6 Coords) (nth 7 Coords))))
((= TopRightVertice 1)
(setq Coords (list (nth 0 Coords) (nth 1 Coords) (car TopRightIntersection) (cadr TopRightIntersection) (nth 4 Coords) (nth 5 Coords) (nth 6 Coords) (nth 7 Coords))))
((= TopRightVertice 2)
(setq Coords (list (nth 0 Coords) (nth 1 Coords) (nth 2 Coords) (nth 3 Coords) (car TopRightIntersection) (cadr TopRightIntersection) (nth 6 Coords) (nth 7 Coords))))
((= TopRightVertice 3)
(setq Coords (list (nth 0 Coords) (nth 1 Coords) (nth 2 Coords) (nth 3 Coords) (nth 4 Coords) (nth 5 Coords) (car TopRightIntersection) (cadr TopRightIntersection)))))
) ; defun

(defun fndtopunit ();finding which top unit is right above bottom unit
(setq TempListLength (sslength AllTopRectangles))
(setq TempCounter 0)
(setq TempRectangle Rectangle)
(setq TempDistance 2000000)

(while (> TempListLength 0)
(setq TempListLength (- TempListLength 1))
(setq Rectangle (vlax-ename->vla-object (ssname AllTopRectangles Counter)))
(lrpbl) (lrpbr) (fndmiddlelineT)
(if (< (- LowerMiddlePointX UpperMiddlePointX) TempDistance) (progn
(setq TempDistance (- LowerMiddlePointX UpperMiddlePointX))
(setq UpperRectangle Rectangle)
(setq BottomLeftVerticeSet BottomLeftVertice)
(setq BottomRightVerticeSet BottomRightVertice)))
(setq TempCounter (+ TempCounter 1))
); end while

(setq Rectangle TempRectangle)
) ; defun

(defun fndmiddlelineB ();finding the center X value between two points on the bottom
(setq TempLeftX (car (vpt TopLeftVertice)))
(setq TempRightX (car (vpt TopRightVertice)))
(setq LowerMiddlePointX (/ (+ TempLeftX TempRightX) 2))
) ; defun

(defun fndmiddlelineT ();finding the center X value between two points on the top
(setq TempLeftX (car (vpt BottomLeftVertice)))
(setq TempRightX (car (vpt BottomRightVertice)))
(setq UpperMiddlePointX (/ (+ TempLeftX TempRightX) 2))
) ; defun

(princ "\nSelect all BOTTOM wall unit rectangles to project (type 'f' and use the fence option): ")
(setq AllRectangles (ssget))

(princ "\nSelect all TOP wall unit rectangles to project TO (type 'f' and use the fence option): ")
(setq AllTopRectangles (ssget))

(setq ListLength (sslength AllRectangles))
(setq Counter 0)

(while (> ListLength 0)
(setq ListLength (- ListLength 1))
(setq Rectangle (vlax-ename->vla-object (ssname AllRectangles Counter)))
(setq Coords (vlax-get Rectangle 'Coordinates))
(lrptl) (lrptr) (fndmiddlelineB) (fndtopunit)
(setq RectanglePoint (vpt TopLeftVertice))
(setq TopLeftIntersection (fndint))
(setq RectanglePoint (vpt TopRightVertice))
(setq TopRightIntersection (fndint))
(swpcoords)
(vlax-put Rectangle 'Coordinates Coords)
(setq Counter (+ Counter 1))
); end while

(princ)
)