How to Stretch or reduce Rectangles Based on two Polyline boundaries ?

[John Camper]

Hello,

I have two polyline as Boundaries and a Rectangle . The case is that the rectangle length must not exceed the polyline Boundaries on both sides nor be less than those polyline Boundaries distance on both sides (ie Rectangle length = Two Boundaries Distance) . Is there any lisp through which it can be achieved ? 

[Tharwat]

I believe using the stretch command would be faster and fewer step inputs than any custom program if the case is just like that.

[marko_ribar]

Here, help yourself...

 

(defun c:polyboundrect ( / ss s1 s2 rect rectx b1 b2 x1 x2 pl p0 p1 p2 p3 )
  (prompt "\nSelect LWPOLYLINE or LINE BOUNDARIES and RECTANGLE LWPOLYLINE...")
  (if (setq ss (ssget "_:L" '((0 . "LWPOLYLINE,LINE"))))
    (progn
      (sssetfirst nil ss)
      (setq s1 (ssget "_I" '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1) (90 . 4) (-4 . "<not") (-4 . "<>") (42 . 0.0) (-4 . "not>"))))
      (sssetfirst nil ss)
      (setq s2 (ssget "_I" '((-4 . "<or") (0 . "LINE") (-4 . "<and") (0 . "LWPOLYLINE") (-4 . "<not") (-4 . "&=") (70 . 1) (-4 . "not>") (90 . 2) (-4 . "<not") (-4 . "<>") (42 . 0.0) (-4 . "not>") (-4 . "and>") (-4 . "or>"))))
      (sssetfirst)
      (setq rect (ssname s1 0))
      (setq rectx (entget rect))
      (setq b1 (ssname s2 0))
      (setq b2 (ssname s2 1))
      (setq x1 (car (trans (cdr (assoc 10 (entget b1))) (if (= (cdr (assoc 0 (entget b1))) "LINE") 0 rect) 1)))
      (setq x2 (car (trans (cdr (assoc 10 (entget b2))) (if (= (cdr (assoc 0 (entget b2))) "LINE") 0 rect) 1)))
      (setq pl (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 rectx))) rect 1)) (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) rectx))))
      (setq p0 (car (vl-sort pl '(lambda ( a b ) (if (= (car a) (car b)) (< (cadr a) (cadr b)) (< (car a) (car b)))))))
      (setq p1 (car (vl-remove-if-not '(lambda ( x ) (= (cadr x) (cadr p0)) (> (car x) (car p0))) (vl-remove p0 pl))))
      (setq p2 (car (vl-remove-if-not '(lambda ( x ) (= (car x) (car p1)) (> (cadr x) (cadr p0))) (vl-remove p1 (vl-remove p0 pl)))))
      (setq p3 (car (vl-remove p2 (vl-remove p1 (vl-remove p0 pl)))))
      (if (< x1 x2)
        (progn
          (setq p0 (trans (list x1 (cadr p0)) 1 rect))
          (setq p1 (trans (list x2 (cadr p1)) 1 rect))
          (setq p2 (trans (list x2 (cadr p2)) 1 rect))
          (setq p3 (trans (list x1 (cadr p3)) 1 rect))
        )
        (progn
          (setq p0 (trans (list x2 (cadr p0)) 1 rect))
          (setq p1 (trans (list x1 (cadr p1)) 1 rect))
          (setq p2 (trans (list x1 (cadr p2)) 1 rect))
          (setq p3 (trans (list x2 (cadr p3)) 1 rect))
        )
      )
      (setq rectx (append (reverse (member (assoc 39 rectx) (reverse rectx))) (list (cons 10 p0) (cons 10 p1) (cons 10 p2) (cons 10 p3)) (list (assoc 210 rectx))))
      (entupd (cdr (assoc -1 (entmod rectx))))
    )
  )
  (princ)
)

 

M.R.

Edited June 17, 2023 by marko_ribar

[DELLA MAGGIORA YANN]

SUPER LISP
Would it be possible to extend a single segment to a single line, Segment, polyline or x-line???
By preserving the orientation of adjacent segments
Thank you in advance, I've been looking for several weeks

Edited January 20 by DELLA MAGGIORA YANN

[marko_ribar]

For that why not just use EXTEND command...

[DELLA MAGGIORA YANN]

it only works on rectangles
I would like this to work on polygons.
while preserving the orientation of adjacent segments
in the APLUS plugin there is a command in this style
a selection of the limit and then on the segment of the polygon to move.
segment will therefore be superimposed on the selected limit.
this also works on a limit projection

[DELLA MAGGIORA YANN]

https://www.cadaplus.com/features/_mp4/alpl.mp4

[DELLA MAGGIORA YANN]

yes, that's right, you understood my problem.
but you will have the possibility of making your lisp work for only one side, that would not be bad. THANKS

[XDSoft]

On 1/21/2024 at 3:34 AM, DELLA MAGGIORA YANN said:

https://www.cadaplus.com/features/_mp4/alpl.mp4

I wrote one using XDRX API. It should have more functions than your video. It can EXTEND multiple edges.

 

I don’t know how to post animations. For details, please see: https://www.theswamp.org/index.php?topic=59151.0

 

animations link,click to see:  http://www.theswamp.org/index.php?action=dlattach;topic=59151.0;attach=42200;image

 

(defun c:xdtb_polyextend (/ e1 e2 e3 inx1 inx2 bak)
  (if (and (setq e1 (xdrx-entsel (xdrx-string-multilanguage "\n拾取多段线延伸起始边<结束>:"
							    "\nPick Polyline Extend start Edge<Exit>:"
				 )
				 '((0 . "*polyline"))
		    )
	   )
	   (or (setq e2	(xdrx-entsel (xdrx-string-multilanguage	"\n拾取延伸结束边<alone>:"
								"\nPick Extend end Edge<Exit>:"
				     )
				     '((0 . "*polyline"))
			)
	       )
	       t
	   )
	   (equal (car e1) (car e2))
      )
    (progn (xd::begin)
	   (setq inx1 (xdrx-getpropertyvalue (car e1) "onseg" (cadr e1))
		 inx2 inx1
	   )
	   (if e2
	     (setq inx2 (xdrx-getpropertyvalue (car e2) "onseg" (cadr e2)))
	   )
	   (if (setq e3	(xdrx-entsel (xdrx-string-multilanguage	"\n拾取目标边<退出>:"
								"\nPick Dest Edge<Exit>:"
				     )
				     '((0 . "*polyline,line,arc,circle"))
			)
	       )
	     (progn (setq bak (xdrx-object-clone (car e1)))
		    (xdrx-polyline-extend inx1 inx2 e1 e3)
		    (xdrx-entity-matchprop bak (car e1))
		    (xdrx-entity-delete bak)
	     )
	   )
	   (xd::end)
    )
  )
  (princ)
)

 

Edited January 23 by XDSoft

[DELLA MAGGIORA YANN]

thank's but don't works for 

 i have bricscad 2024

i have a message error 

; ----- LISP : Call Stack -----
; [0]...C:XDTB_POLYEXTEND <<--
;
; ----- Error around expression -----
; (XDRX-ENTSEL (XDRX-STRING-MULTILANGUAGE "
Choisissez une polyligne et prolongez le bord de début <fin>:" "
Pick Polyline Extend start Edge<Exit>:") '((0 . "*polyline")))
; in file : 
; E:\MA CLE\reisntall - Copie\BRICSCAD YD 24\xdtb_polyextend.lsp
;
; error : no function definition <XDRX-ENTSEL> ; expected FUNCTION at [eval]