Rectangle Extend
So rectangle as a such is not supposed to retain its shape, but what we looking for is an area of certain width (or heigth) limited by two staight lines, and curved boundary. To achieve that you dont need lisp. Create set of paralell linse (horizontal or vertical) with dezired spacing that strech from boundary to boundary, and use autocad command BOUNDARY or shortly BO, use option "select boundary set", select all object and hit enter.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
@Anonymous If you want to retain rectangle object, but to cover boundary object I'll have to change a code so that it finds intersections of both rectangle sides with boundary object, and use londer distance from axis of starting rectangle. I'll try to modify this later today.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Some potential complications that will need to be accounted for, if such variations in relationships might occur:
In the situation on the left, the red rectangle would need to be stretched so that its left edge meets both the upper and lower boundary edges. But in the situation in the middle, the left rectangle edge would need to reach the top boundary edge, but the right rectangle edge would need to meet the bottom boundary edge.
Would you ever have a situation such as on the right? The routine by @hak_vz [so far] uses the extension of a single Line to find virtual intersections with the boundary, but it only allows for there being two such intersections. In this situation there are four virtual intersections, so some way would need to be found to determine which are the correct ones to use.
Not that all of these things couldn't be accomplished, presumably with a whole lot of comparisons of distances between points, but it's complicated....
Kent Cooper, AIA 
Here is updated code that that extends rectangle in any direction, and overlaps with boundary object. In case of complex boundary some manual trimming will be needed.Basic rectangle is lost and new is created from line objects so joining is needed, and placing them to appropriate layer .... If it works for you, select this as a final solution!
(defun c:extend_rects ( / acadObj doc modelSpace ss i boundary_element pts ma mb
mc md mp m1 m2 dis_1 dis_2 direction lineObj lo lol intPoints pa pb pc pd
r1 r2 p1 p2 p3 p4 ang1 ang2 ent st *error*)
; hak_vz 19.01.2020
;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
;
(vl-load-com)
(defun *error* () (setvar 'cmdecho 1) (princ))
(defun getpoints (e / i ent pts)
(setq
ent
(entget e)
i 0
)
(repeat
(length ent)
(if (eq (car (nth i ent)) 10)
(setq
pts
(append pts (list (cdr (nth i ent))))
)
)
(setq
i
(+ i 1)
)
)
pts
)
(defun midpoint (pt1 pt2)(list (/ (+ (car pt1) (car pt2)) 2.0)(/ (+ (cadr pt1)(cadr pt2)) 2.0)))
(setq acadObj (vlax-get-acad-object))
(setq doc (vla-get-ActiveDocument acadObj))
(setq modelSpace (vla-get-ModelSpace doc))
(princ "\nSelect rectangles >")
(setq ss (ssget) i 0)
(setq boundary_element (car(entsel "\nSelect extension boundary >")))
(setvar 'cmdecho 0)
(cond
((and ss)
(while (< i (sslength ss))
(setq
pts (getpoints (ssname ss i))
ma (midpoint (nth 0 pts) (nth 1 pts))
mb (midpoint (nth 1 pts)(nth 2 pts))
mc (midpoint (nth 2 pts) (nth 3 pts))
md (midpoint (nth 3 pts) (nth 0 pts))
dis_1 (distance ma mc)
dis_2 (distance mb md)
)
(if (> dis_1 dis_2)
(setq direction (list ma mc) rectwidth (distance mb md))
(setq direction (list mb md) rectwidth (distance ma mc))
)
(setq ang1 (+ (angle (car direction)(cadr direction))(/ pi 2)))
(setq ang2 (- (angle (car direction)(cadr direction))(/ pi 2)))
(setq mp (midpoint(car direction)(cadr direction)))
(setq m1 (polar mp ang1 (/ rectwidth 2.0)))
(setq m2 (polar mp ang2 (/ rectwidth 2.0)))
(setq pts nil lineObj (vla-Addline modelSpace (vlax-3d-point (car direction)) (vlax-3d-point (cadr direction))))
(setq lo (entlast))
(command "_.copy" lo "" mp m1)
(setq side1 (entlast))
(command "_.copy" lo "" mp m2)
(setq side2 (entlast))
(setq intPoints1 (vla-IntersectWith (vlax-ename->vla-object side1) (vlax-ename->vla-object boundary_element) 1))
(setq intPoints2 (vla-IntersectWith (vlax-ename->vla-object side2) (vlax-ename->vla-object boundary_element) 1))
(entdel (entlast)) ;delete side1
(entdel (entlast)) ;delete side1
(setq intPoints1 (vlax-variant-value intPoints1))
(setq intPoints2 (vlax-variant-value intPoints2))
(setq intPoints1 (vlax-safearray->list intPoints1))
(setq intPoints2 (vlax-safearray->list intPoints2))
(setq pa (list (nth 0 intPoints1)(nth 1 intPoints1) (nth 2 intPoints1)) pb (list (nth 3 intPoints1)(nth 4 intPoints1)(nth 5 intPoints1)))
(setq pc (list (nth 0 intPoints2)(nth 1 intPoints2) (nth 2 intPoints2)) pd (list (nth 3 intPoints2)(nth 4 intPoints2)(nth 5 intPoints2)))
(setq r1 (ssname ss i))
(command "_.copy" r1 "" "_non" '(0 0 0) "_non" '(0 0 0))
(setq r2 (entlast))
(setq p1 pa)
(setq p4 pb)
(setq p2 (polar p1 ang2 rectwidth))
(setq p3 (polar p4 ang2 rectwidth))
(setq ent (entget r1))
(setq ent (vl-remove-if '(lambda (x) (= (car x) 10)) ent))
(setq ent (apply 'append (cons ent (mapcar 'list (mapcar '(lambda (a) (cons 10 a)) (list p1 p2 p3 p4))))))
(setq ent (entmod ent))
(setq p1 pc)
(setq p4 pd)
(setq p2 (polar p1 ang1 rectwidth))
(setq p3 (polar p4 ang1 rectwidth))
(setq ent (entget r2))
(setq ent (vl-remove-if '(lambda (x) (= (car x) 10)) ent))
(setq ent (apply 'append (cons ent (mapcar 'list (mapcar '(lambda (a) (cons 10 a)) (list p1 p2 p3 p4))))))
(setq ent (entmod ent))
(command "region" r1 "")
(setq r1 (entlast))
(command "region" r2 "")
(setq r2 (entlast))
(command "_.union" r1 r2 "")
(command "_.explode" (entlast))
(setvar 'cmdecho 1)
(entdel lo)
(setq i (+ i 1))
)
))
(princ)
)
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Final code that extracts rectangles in any direction, with line joining
(defun c:extend_rects ( / acadObj doc modelSpace ss i boundary_element pts ma mb
mc md mp m1 m2 dis_1 dis_2 direction lineObj lo lol intPoints pa pb pc pd
r1 r2 p1 p2 p3 p4 ang1 ang2 ent st *error*)
; hak_vz 19.01.2020
;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
;
(vl-load-com)
(defun *error* () (setvar 'cmdecho 1) (princ))
(defun getpoints (e / i ent pts)
(setq
ent
(entget e)
i 0
)
(repeat
(length ent)
(if (eq (car (nth i ent)) 10)
(setq
pts
(append pts (list (cdr (nth i ent))))
)
)
(setq
i
(+ i 1)
)
)
pts
)
(defun midpoint (pt1 pt2)(list (/ (+ (car pt1) (car pt2)) 2.0)(/ (+ (cadr pt1)(cadr pt2)) 2.0)))
(setq acadObj (vlax-get-acad-object))
(setq doc (vla-get-ActiveDocument acadObj))
(setq modelSpace (vla-get-ModelSpace doc))
(princ "\nSelect rectangles >")
(setq ss (ssget) i 0)
(setq boundary_element (car(entsel "\nSelect extension boundary >")))
(setvar 'cmdecho 0)
(cond
((and ss)
(while (< i (sslength ss))
(setq
pts (getpoints (ssname ss i))
ma (midpoint (nth 0 pts) (nth 1 pts))
mb (midpoint (nth 1 pts)(nth 2 pts))
mc (midpoint (nth 2 pts) (nth 3 pts))
md (midpoint (nth 3 pts) (nth 0 pts))
dis_1 (distance ma mc)
dis_2 (distance mb md)
)
(if (> dis_1 dis_2)
(setq direction (list ma mc) rectwidth (distance mb md))
(setq direction (list mb md) rectwidth (distance ma mc))
)
(setq ang1 (+ (angle (car direction)(cadr direction))(/ pi 2)))
(setq ang2 (- (angle (car direction)(cadr direction))(/ pi 2)))
(setq mp (midpoint(car direction)(cadr direction)))
(setq m1 (polar mp ang1 (/ rectwidth 2.0)))
(setq m2 (polar mp ang2 (/ rectwidth 2.0)))
(setq pts nil lineObj (vla-Addline modelSpace (vlax-3d-point (car direction)) (vlax-3d-point (cadr direction))))
(setq lo (entlast))
(command "_.copy" lo "" mp m1)
(setq side1 (entlast))
(command "_.copy" lo "" mp m2)
(setq side2 (entlast))
(setq intPoints1 (vla-IntersectWith (vlax-ename->vla-object side1) (vlax-ename->vla-object boundary_element) 1))
(setq intPoints2 (vla-IntersectWith (vlax-ename->vla-object side2) (vlax-ename->vla-object boundary_element) 1))
(entdel (entlast)) ;delete side1
(entdel (entlast)) ;delete side1
(setq intPoints1 (vlax-variant-value intPoints1))
(setq intPoints2 (vlax-variant-value intPoints2))
(setq intPoints1 (vlax-safearray->list intPoints1))
(setq intPoints2 (vlax-safearray->list intPoints2))
(setq pa (list (nth 0 intPoints1)(nth 1 intPoints1) (nth 2 intPoints1)) pb (list (nth 3 intPoints1)(nth 4 intPoints1)(nth 5 intPoints1)))
(setq pc (list (nth 0 intPoints2)(nth 1 intPoints2) (nth 2 intPoints2)) pd (list (nth 3 intPoints2)(nth 4 intPoints2)(nth 5 intPoints2)))
(setq r1 (ssname ss i))
(command "_.copy" r1 "" "_non" '(0 0 0) "_non" '(0 0 0))
(setq r2 (entlast))
(setq p1 pa)
(setq p4 pb)
(setq p2 (polar p1 ang2 rectwidth))
(setq p3 (polar p4 ang2 rectwidth))
(setq ent (entget r1))
(setq ent (vl-remove-if '(lambda (x) (= (car x) 10)) ent))
(setq ent (apply 'append (cons ent (mapcar 'list (mapcar '(lambda (a) (cons 10 a)) (list p1 p2 p3 p4))))))
(setq ent (entmod ent))
(setq p1 pc)
(setq p4 pd)
(setq p2 (polar p1 ang1 rectwidth))
(setq p3 (polar p4 ang1 rectwidth))
(setq ent (entget r2))
(setq ent (vl-remove-if '(lambda (x) (= (car x) 10)) ent))
(setq ent (apply 'append (cons ent (mapcar 'list (mapcar '(lambda (a) (cons 10 a)) (list p1 p2 p3 p4))))))
(setq ent (entmod ent))
(setq lol lo)
(command "region" r1 "")
(setq r1 (entlast))
(command "region" r2 "")
(setq r2 (entlast))
(command "_.union" r1 r2 "")
(command "_.explode" (entlast))
(setq stt (ssadd))
(while (setq lo (entnext lo))
(ssadd lo stt)
)
(initcommandversion)
(command "_.join" stt "")
(entdel lol)
(setq i (+ i 1))
)
))
(setvar 'cmdecho 1)
(princ)
)
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Upper code now extends both rectangle sides and looks for maximum distance to boundary (@Kent1Cooper message 24). To avoid too much testing it creates two overlaping rectangles, converts them to regions and create its union. That region is exploded and resulting lines are joined into a new rectangle.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
hak_vz
Sorry for the delayed response, and thanks to everyone who has contributed to this lisp. I've done some heavy testing with this lisp and it works great except for the three examples i have attached. The first image on the top left hand side goes completely through the rectangle, would it be possible to tell the rectangle to stop at the first intersection if desired and if not click the rectangle again to make it extend to the next intersection point? Second image on the top right hand side, is a similar problem to the first. I started on the bottom side of the polygon and when i ran the lisp it flipped to the other side. The third problem is the rectangle didn't extend to cover the entire area (the first rectangle from the left) is there a way to make it cover the entire area?
@Anonymous wrote:hak_vz
The first image on the top left hand side goes completely through the rectangle, would it be possible to tell
the rectangle to stop at the first intersection if desired and if not click the rectangle again to make it extend to the next intersection point? Second image on the top right hand side, is a similar problem to the first. I started on the bottom side of the polygon and when i ran the lisp it flipped to the other side. The third problem is the rectangle didn't extend to cover the entire area (the first rectangle from the left) is there a way to make it cover the entire area?
Case 1 ) Create a line that goes across both objects, then use command "boundary" or shortly "bo" to create two separate temporary areas and then use command on this new objects. This are two separate object and we have to make them part of a single boundary that has a smooth and uninterrupted "flow" (upper right case)
Case 2) Apply same logic and separate shape to two areas (two rectangles)
Case 3) Huh, maybe but would need complex logic. Simpler solution is just to pedit extended rectangle and insert a vertex (pedit -> edit vertexes -> next or insert)
To have all this cases solved in a code one would have to apply a lots of logical thinking.
Generally in this forum you'll receive a decent solution but don't expect that someone will bother with it if solution is to complex. To override problem with finding stretch to cover whole boundary I've applied a solution that just crossed my mind (using regions and union) and it just worked. Otherwise I would not bother with complex mathematics. But luckily for you it works, at least for some cases. You may place your starting rectangles inside, or even outside, so some interesting results may happen. I'll try to update code so that it accepts more than one shapes as a boundary, but not before weekend.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
As I have written in my previous post solution to situations you showed is to split complex object or an shape that consists from more then one boundary object is to split it to simple subareas and then applying code to those subareas, as showed in attached images. Complex shape with square hole inside has been divided in subareas (magenta). In case where original boundary doesn't satisfy correct rectangle extension (number of intersection greater then two) use subdivided areas created using command boundary or just a simple rectangle. For uncovered edges use pedit -> edit vertexes -> insert vertex and add one or more vertexes . Adding into algorithm additional boundaries and special cases to handle would make code to complex and additional problems my emerge. But, as I stated in one other post "Autocad is preliminarily a drafting software" so running code more then once shouldn't be a problem".
Here is updated code that handles region creation better without polluting console and has updated undo handling-
Select this code as a final solution (drop down menu -> rectangle aside with three dots)
(defun c:extend_rects( / acadObj doc modelSpace ss i boundary_element pts ma mb
mc md mp m1 m2 dis_1 dis_2 direction lineObj lo lol intPoints pa pb pc pd
r1 r2 p1 p2 p3 p4 ang1 ang2 ent st curves *error*)
; hak_vz 25.01.2020
;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
;
(vl-load-com)
(defun *error* () (setvar 'cmdecho 1) (princ))
(defun getpoints (e / i ent pts)
(setq
ent
(entget e)
i 0
)
(repeat
(length ent)
(if (eq (car (nth i ent)) 10)
(setq
pts
(append pts (list (cdr (nth i ent))))
)
)
(setq
i
(+ i 1)
)
)
pts
)
(defun midpoint (pt1 pt2)(list (/ (+ (car pt1) (car pt2)) 2.0)(/ (+ (cadr pt1)(cadr pt2)) 2.0)))
(princ "\nSelect rectangles >")
(setq
acadObj (vlax-get-acad-object)
doc (vla-get-ActiveDocument acadObj)
modelSpace (vla-get-ModelSpace doc)
ss (ssget)
i 0
boundary_element (car(entsel "\nSelect extension boundary >"))
)
(setvar 'cmdecho 0)
(vla-startundomark doc)
(cond
((and ss)
(while (< i (sslength ss))
(setq
pts (getpoints (ssname ss i))
ma (midpoint (nth 0 pts) (nth 1 pts))
mb (midpoint (nth 1 pts)(nth 2 pts))
mc (midpoint (nth 2 pts) (nth 3 pts))
md (midpoint (nth 3 pts) (nth 0 pts))
dis_1 (distance ma mc)
dis_2 (distance mb md)
)
(if (> dis_1 dis_2)
(setq direction (list ma mc) rectwidth (distance mb md))
(setq direction (list mb md) rectwidth (distance ma mc))
)
(setq
ang1 (+ (angle (car direction)(cadr direction))(/ pi 2))
ang2 (- (angle (car direction)(cadr direction))(/ pi 2))
mp (midpoint(car direction)(cadr direction))
m1 (polar mp ang1 (/ rectwidth 2.0))
m2 (polar mp ang2 (/ rectwidth 2.0))
pts nil
lineObj (vla-Addline modelSpace (vlax-3d-point (car direction)) (vlax-3d-point (cadr direction)))
lo (entlast)
)
(command "_.copy" lo "" mp m1)
(setq side1 (entlast))
(command "_.copy" lo "" mp m2)
(setq
side2 (entlast)
intPoints1 (vla-IntersectWith (vlax-ename->vla-object side1) (vlax-ename->vla-object boundary_element) 1)
intPoints2 (vla-IntersectWith (vlax-ename->vla-object side2) (vlax-ename->vla-object boundary_element) 1)
)
(entdel (entlast)) ;delete side1
(entdel (entlast)) ;delete side1
(setq
intPoints1 (vlax-variant-value intPoints1)
intPoints2 (vlax-variant-value intPoints2)
intPoints1 (vlax-safearray->list intPoints1)
intPoints2 (vlax-safearray->list intPoints2)
pa (list (nth 0 intPoints1)(nth 1 intPoints1) (nth 2 intPoints1))
pb (list (nth 3 intPoints1)(nth 4 intPoints1)(nth 5 intPoints1))
pc (list (nth 0 intPoints2)(nth 1 intPoints2) (nth 2 intPoints2))
pd (list (nth 3 intPoints2)(nth 4 intPoints2)(nth 5 intPoints2))
r1 (ssname ss i)
)
(command "_.copy" r1 "" "_non" '(0 0 0) "_non" '(0 0 0))
(setq
r2 (entlast)
p1 pa
p4 pb
p2 (polar p1 ang2 rectwidth)
p3 (polar p4 ang2 rectwidth)
ent (entget r1)
ent (vl-remove-if '(lambda (x) (= (car x) 10)) ent)
ent (apply 'append (cons ent (mapcar 'list (mapcar '(lambda (a) (cons 10 a)) (list p1 p2 p3 p4)))))
ent (entmod ent)
)
(setq
p1 pc
p4 pd
p2 (polar p1 ang1 rectwidth)
p3 (polar p4 ang1 rectwidth)
ent (entget r2)
ent (vl-remove-if '(lambda (x) (= (car x) 10)) ent)
ent (apply 'append (cons ent (mapcar 'list (mapcar '(lambda (a) (cons 10 a)) (list p1 p2 p3 p4)))))
ent (entmod ent)
lol lo
)
(setq curves (vlax-make-safearray vlax-vbObject '(0 . 0)))
(vlax-safearray-put-element curves 0 (vlax-ename->vla-object r1))
(vla-AddRegion modelSpace curves)
(entdel r1)
(setq r1 (entlast))
(setq curves (vlax-make-safearray vlax-vbObject '(0 . 0)))
(vlax-safearray-put-element curves 0 (vlax-ename->vla-object r2))
(vla-AddRegion modelSpace curves)
(entdel r2)
(setq r2 (entlast))
(command "_.union" r1 r2 "")
(command "_.explode" (entlast))
(setq stt (ssadd))
(while (setq lo (entnext lo))
(ssadd lo stt)
)
(initcommandversion)
(command "_.join" stt "")
(entdel lol)
(setq i (+ i 1))
)
)
)
(vla-endundomark doc)
(setvar 'cmdecho 1)
(princ)
)
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
@AnonymousHave you test this final code, how it works in practice?
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Hello, the Lisp you wrote helped me a lot in my work. When I extend the square, can I extend only one side, not both sides? Or can I extend the square to a simple line or a polyline? (English is not my first language, I would appreciate it if you could understand my poor English.)
Original lisp is written so that it extends both rectangle sides. If you need to extend only one side then i thing using command STRETCH is much quicker option. Code that extends only single side needs that user selects a side and edge to extend. Using such code on multiple elements to extend automatically can produce wrong result.
If you have spacial particular request to solve, start new post, add detailed explanation with sample drawing and add link to this post in request for easier following. I can than modify my code according to your wishes.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Hello, the Lisp you wrote helped me a lot in my work. But i want to extend rectangle to circle object and it still out of object ( one corner touch to circle). Please help me! Thanks and best regard.
@phamhunghntb wrote:
Hello, the Lisp you wrote helped me a lot in my work. But i want to extend rectangle to circle object and it still out of object ( one corner touch to circle). Please help me! Thanks and best regard.
Create outer boundary (let say a rectangle) with circle inside). Connect outer and inner boundary into a single polyline object. Use two narrowly spaced polylines to separate this into two areas and then use command. Code is created so that it uses single (outer) boundary. Check older posts for further explanations, and to find idea how to use it to solve your particular problem.
Unfortunately I don't have time to modify my code.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.