Select Rectangles to change their Lenths and Widths at once.

Select Rectangles to change their Lenths and Widths at once.

Anonymous
Not applicable
5,176 Views
20 Replies
Message 1 of 21

Select Rectangles to change their Lenths and Widths at once.

Anonymous
Not applicable

Hello,
I am sad because in the Properties Palette (Ctrl+1)
of the Rectangles there are no rows with Length and Width
of the selected Rectangle, so I can't change these important properties
so easy.
I can understand it, because there is not such Object Type as Rectangle in Autocad;
if you select a rectangle, in the Properties Palette you can see, that
it is simply a Polyline.
I want to write lisp
"Select Rectangles to change their Lenths and Widths at once to the values determined by keyboard or by picking two points: "
"Specify Width: "
"Specify Height: ".
You could determine Length and Width either by typing the value with keyboard
or by clicking on two points.
(so it is in the commands SCALE, LENGTHEN -> TOTAL, LENGTHEN -> DELTA;
The prompt is that you should specify the value with keyboard,
but you could pick two points do determine ScaleFactor/ NewLength.).
I want to write such lisp, but I am not so good at lisp writing to do so.
Please, help.
Is this possible, to write such lisp?

0 Likes
5,177 Views
20 Replies
Replies (20)
Message 2 of 21

marko_ribar
Advisor
Advisor

See if this lisp can help you...

 

(defun rectangle-p ( e f / nobulge-p dpar stp enp ptn k parpts index ptlst )

   (vl-load-com)

   (defun nobulge-p ( e i f )
      (apply 'and (mapcar '(lambda (x) (equal (vla-getbulge e x) 0.0 f)) i))
   )

   (setq dpar (/ (+ (abs (setq enp (vlax-curve-getendparam e))) (abs (setq stp (vlax-curve-getstartparam e)))) (setq ptn (cdr (assoc 90 (entget e))))))
   (setq k -1.0)
   (repeat ptn
      (setq parpts (append parpts (setq parpts (list (+ stp (* (setq k (1+ k)) dpar))))))
   )
   (setq k -1)
   (repeat ptn
      (setq index (append index (setq index (list (setq k (1+ k))))))
   )
   (setq ptlst (mapcar '(lambda (x) (vlax-curve-getpointatparam e x)) parpts))
   (and
      (eq ptn 4)
      (nobulge-p (if (eq (type e) 'ENAME) (vlax-ename->vla-object e) e) index f)
      (equal (distance (nth 0 ptlst) (nth 1 ptlst)) (distance (nth 2 ptlst) (nth 3 ptlst)) f)
      (equal (distance (nth 1 ptlst) (nth 2 ptlst)) (distance (nth 3 ptlst) (nth 0 ptlst)) f)
      (equal (distance (nth 0 ptlst) (nth 2 ptlst)) (distance (nth 1 ptlst) (nth 3 ptlst)) f)
   )
)

(defun c:recedit ( / ch d ddl ddw dn i l nl nw op opl opw p2 p3 p4 pdxf rec scfl scfw sdxf ss vrec vrec10n w )
  (prompt "\nSelect rectangles you want to edit...")
  (setq ss (ssget "_:L" '((0 . "LWPOLYLINE") (90 . 4) (-4 . "<or") (70 . 1) (70 . 129) (-4 . "or>"))))
  (while (or (not ss) (vl-some '(lambda ( x ) (eq x nil)) (mapcar '(lambda ( x ) (rectangle-p x 1e-8)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))))
    (prompt "\nEmpty sel.set or some of selected LWPOLYLINE(s) doesn't belong to rectangles... Try selecting rectangle(s) again...")
    (setq ss (ssget "_:L" '((0 . "LWPOLYLINE") (90 . 4) (-4 . "<or") (70 . 1) (70 . 129) (-4 . "or>"))))
  )
  (initget "All Single")
  (setq ch (getkword "\nProcess all rectangles or one by one [All/Single] <All> : "))
  (if (null ch) (setq ch "All"))
  (cond
    ( (eq ch "All")
      (initget 1 "SC DE")
      (setq op (getkword "\nChoose option (Scale Width-Length/Delta Width-Length) [SC/DE] : "))
      (cond
        ( (eq op "SC")
          (initget 3)
          (setq scfw (getreal "\nSpecify positive or negative Width scale factor : "))
          (initget 3)
          (setq scfl (getreal "\nSpecify positive or negative Length scale factor : "))
          (repeat (setq i (sslength ss))
            (setq rec (ssname ss (setq i (1- i))))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (car vrec) (cadr vrec)))
            (setq dn (* d scfw))
            (setq p2 (polar (car vrec) (angle (car vrec) (cadr vrec)) dn))
            (setq p3 (polar (cadddr vrec) (angle (cadddr vrec) (caddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) p2 p3 (cadddr vrec))))
            (setq pdxf (reverse (cdr (member (car vrec10n) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cadddr vrec10n) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (cadr vrec) (caddr vrec)))
            (setq dn (* d scfl))
            (setq p3 (polar (cadr vrec) (angle (cadr vrec) (caddr vrec)) dn))
            (setq p4 (polar (car vrec) (angle (car vrec) (cadddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) (cadr vrec) p3 p4)))
            (setq pdxf (reverse (cdr (member (car vrec10n) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cadddr vrec10n) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
          )
        )
        ( (eq op "DE")
          (initget 1 "+ -")
          (setq opw (getkword "\nSpecify positive or negative delta input for Width [+/-] : "))
          (initget 5)
          (setq ddw (getdist "\nPick or specify delta Width value : "))
          (initget 1 "+ -")
          (setq opl (getkword "\nSpecify positive or negative delta input for Length [+/-] : "))
          (initget 5)
          (setq ddl (getdist "\nPick or specify delta Length value : "))
          (repeat (setq i (sslength ss))
            (setq rec (ssname ss (setq i (1- i))))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (car vrec) (cadr vrec)))
            (setq dn ((eval (read opw)) d ddw))
            (setq p2 (polar (car vrec) (angle (car vrec) (cadr vrec)) dn))
            (setq p3 (polar (cadddr vrec) (angle (cadddr vrec) (caddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) p2 p3 (cadddr vrec))))
            (setq pdxf (reverse (cdr (member (car vrec10n) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cadddr vrec10n) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (cadr vrec) (caddr vrec)))
            (setq dn ((eval (read opl)) d ddl))
            (setq p3 (polar (cadr vrec) (angle (cadr vrec) (caddr vrec)) dn))
            (setq p4 (polar (car vrec) (angle (car vrec) (cadddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) (cadr vrec) p3 p4)))
            (setq pdxf (reverse (cdr (member (car vrec10n) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cadddr vrec10n) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
          )
        )
      )
    )
    ( (eq ch "Single")
      (repeat (setq i (sslength ss))
        (setq rec (ssname ss (setq i (1- i))))
        (redraw rec 3)
        (initget 1 "WL SC DE")
        (setq op (getkword "\nChoose option (New Width-Length/Scale Width-Length/Delta Width-Length) [WL/SC/DE] : "))
        (cond
          ( (eq op "WL")
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq w (distance (car vrec) (cadr vrec)))
            (setq l (distance (cadr vrec) (caddr vrec)))
            (prompt "\nCurrent Width : ") (princ (rtos w 2 50)) (prompt "\tCurrent Length : ") (princ (rtos l 2 50))
            (initget 1 "+ -")
            (setq opw (getkword "\nSpecify positive or negative input for new Width [+/-] : "))
            (initget 4)
            (setq nw (getdist (strcat "\nPick or specify new Width value <" (rtos w 2 50) "> : ")))
            (if (null nw) (setq nw w))
            (setq nw ((eval (read opw)) 0.0 nw))
            (setq p2 (polar (car vrec) (angle (car vrec) (cadr vrec)) nw))
            (setq p3 (polar (cadddr vrec) (angle (cadddr vrec) (caddr vrec)) nw))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) p2 p3 (cadddr vrec))))
            (setq pdxf (reverse (cdr (member (car vrec10n) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cadddr vrec10n) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (initget 1 "+ -")
            (setq opl (getkword "\nSpecify positive or negative input for new Length [+/-] : "))
            (initget 4)
            (setq nl (getdist (strcat "\nPick or specify new Length value <" (rtos l 2 50) "> : ")))
            (if (null nl) (setq nl l))
            (setq nl ((eval (read opl)) 0.0 nl))
            (setq p3 (polar (cadr vrec) (angle (cadr vrec) (caddr vrec)) nl))
            (setq p4 (polar (car vrec) (angle (car vrec) (cadddr vrec)) nl))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) (cadr vrec) p3 p4)))
            (setq pdxf (reverse (cdr (member (car vrec10n) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cadddr vrec10n) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
          )
          ( (eq op "SC")
            (initget 3)
            (setq scfw (getreal "\nSpecify positive or negative Width scale factor : "))
            (initget 3)
            (setq scfl (getreal "\nSpecify positive or negative Length scale factor : "))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (car vrec) (cadr vrec)))
            (setq dn (* d scfw))
            (setq p2 (polar (car vrec) (angle (car vrec) (cadr vrec)) dn))
            (setq p3 (polar (cadddr vrec) (angle (cadddr vrec) (caddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) p2 p3 (cadddr vrec))))
            (setq pdxf (reverse (cdr (member (car vrec10n) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cadddr vrec10n) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (cadr vrec) (caddr vrec)))
            (setq dn (* d scfl))
            (setq p3 (polar (cadr vrec) (angle (cadr vrec) (caddr vrec)) dn))
            (setq p4 (polar (car vrec) (angle (car vrec) (cadddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) (cadr vrec) p3 p4)))
            (setq pdxf (reverse (cdr (member (car vrec10n) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cadddr vrec10n) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
          )
          ( (eq op "DE")
            (initget 1 "+ -")
            (setq opw (getkword "\nSpecify positive or negative delta input for Width [+/-] : "))
            (initget 5)
            (setq ddw (getdist "\nPick or specify delta Width value : "))
            (initget 1 "+ -")
            (setq opl (getkword "\nSpecify positive or negative delta input for Length [+/-] : "))
            (initget 5)
            (setq ddl (getdist "\nPick or specify delta Length value : "))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (car vrec) (cadr vrec)))
            (setq dn ((eval (read opw)) d ddw))
            (setq p2 (polar (car vrec) (angle (car vrec) (cadr vrec)) dn))
            (setq p3 (polar (cadddr vrec) (angle (cadddr vrec) (caddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) p2 p3 (cadddr vrec))))
            (setq pdxf (reverse (cdr (member (car vrec10n) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cadddr vrec10n) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (cadr vrec) (caddr vrec)))
            (setq dn ((eval (read opl)) d ddl))
            (setq p3 (polar (cadr vrec) (angle (cadr vrec) (caddr vrec)) dn))
            (setq p4 (polar (car vrec) (angle (car vrec) (cadddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) (cadr vrec) p3 p4)))
            (setq pdxf (reverse (cdr (member (car vrec10n) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cadddr vrec10n) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
          )
        )
        (redraw rec 4)
      )
    )
  )
  (princ)
)

 Regards, M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)
0 Likes
Message 3 of 21

Kent1Cooper
Consultant
Consultant

@Anonymous wrote:

.... in the Properties Palette ... of the Rectangles there are no rows with Length and Width of the selected Rectangle, so I can't change these important properties
so easy. .... there is not such Object Type as Rectangle in Autocad; ....


Consider the option of defining a Block that is a one-drawing-unit square, and Inserting that for rectangles, using the X and Y scale factors for the size.  Then you would be able to change the length and width directly in the Properties Palette.  [However, you wouldn't be able to do it by picking points on-screen except with some kind of routine.  But a routine to change the X and/or Y scale factor(s) of an inserted Block to match picked distances would be quite simple.]  One thing you would need to decide is whether the insertion point should be in the middle of the Block or at one of the corners [or you could have one of each].

Kent Cooper, AIA
Message 4 of 21

marko_ribar
Advisor
Advisor

What will you do with delta width and delta length values, Kent?

 

I strongly suggest that you try to use my posted code if you already haven't used it... In addition I've updated it just a slightly to accept sel. set with entities containing both rectangles and lwpolylines with similar properties (4 vetrices) but don't belong to rectangles... Now you will be asked just twicely for a selection quiery and if those lwpolylines exist they will be automatically removed from selection and processing will be made just on real rectangle entities... Also small explanation when using delta options - you can specify 0.0 as input if you want width or length to remain as it is...

 

(defun rectangle-p ( e f / nobulge-p dpar stp enp ptn k parpts index ptlst )

   (vl-load-com)

   (defun nobulge-p ( e i f )
      (apply 'and (mapcar '(lambda (x) (equal (vla-getbulge e x) 0.0 f)) i))
   )

   (setq dpar (/ (+ (abs (setq enp (vlax-curve-getendparam e))) (abs (setq stp (vlax-curve-getstartparam e)))) (setq ptn (cdr (assoc 90 (entget e))))))
   (setq k -1.0)
   (repeat ptn
      (setq parpts (append parpts (setq parpts (list (+ stp (* (setq k (1+ k)) dpar))))))
   )
   (setq k -1)
   (repeat ptn
      (setq index (append index (setq index (list (setq k (1+ k))))))
   )
   (setq ptlst (mapcar '(lambda (x) (vlax-curve-getpointatparam e x)) parpts))
   (and
      (eq ptn 4)
      (nobulge-p (if (eq (type e) 'ENAME) (vlax-ename->vla-object e) e) index f)
      (equal (distance (nth 0 ptlst) (nth 1 ptlst)) (distance (nth 2 ptlst) (nth 3 ptlst)) f)
      (equal (distance (nth 1 ptlst) (nth 2 ptlst)) (distance (nth 3 ptlst) (nth 0 ptlst)) f)
      (equal (distance (nth 0 ptlst) (nth 2 ptlst)) (distance (nth 1 ptlst) (nth 3 ptlst)) f)
   )
)

(defun c:recedit ( / ch d ddl ddw dn i l nl nw op opl opw p2 p3 p4 pdxf rec scfl scfw sdxf ss ssn vrec vrec10n w )
  (prompt "\nSelect rectangles you want to edit...")
  (setq ss (ssget "_:L" '((0 . "LWPOLYLINE") (90 . 4) (-4 . "<or") (70 . 1) (70 . 129) (-4 . "or>"))))
  (while (or (not ss) (vl-some '(lambda ( x ) (eq x nil)) (mapcar '(lambda ( x ) (rectangle-p x 1e-8)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))))
    (prompt "\nEmpty sel.set or some of selected LWPOLYLINE(s) doesn't belong to rectangles... Try selecting rectangle(s) again...")
    (setq ss (ssget "_:L" '((0 . "LWPOLYLINE") (90 . 4) (-4 . "<or") (70 . 1) (70 . 129) (-4 . "or>"))))
    (setq ssn (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
    (foreach e ssn
      (if (not (rectangle-p e 1e-8))
        (ssdel e ss)
      )
    )
  )
  (initget "All Single")
  (setq ch (getkword "\nProcess all rectangles or one by one [All/Single] <All> : "))
  (if (null ch) (setq ch "All"))
  (cond
    ( (eq ch "All")
      (initget 1 "SC DE")
      (setq op (getkword "\nChoose option (Scale Width-Length/Delta Width-Length) [SC/DE] : "))
      (cond
        ( (eq op "SC")
          (initget 3)
          (setq scfw (getreal "\nSpecify positive or negative Width scale factor : "))
          (initget 3)
          (setq scfl (getreal "\nSpecify positive or negative Length scale factor : "))
          (repeat (setq i (sslength ss))
            (setq rec (ssname ss (setq i (1- i))))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (car vrec) (cadr vrec)))
            (setq dn (* d scfw))
            (setq p2 (polar (car vrec) (angle (car vrec) (cadr vrec)) dn))
            (setq p3 (polar (cadddr vrec) (angle (cadddr vrec) (caddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) p2 p3 (cadddr vrec))))
            (setq pdxf (reverse (cdr (member (car vrec10n) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cadddr vrec10n) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (cadr vrec) (caddr vrec)))
            (setq dn (* d scfl))
            (setq p3 (polar (cadr vrec) (angle (cadr vrec) (caddr vrec)) dn))
            (setq p4 (polar (car vrec) (angle (car vrec) (cadddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) (cadr vrec) p3 p4)))
            (setq pdxf (reverse (cdr (member (car vrec10n) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cadddr vrec10n) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
          )
        )
        ( (eq op "DE")
          (initget 1 "+ -")
          (setq opw (getkword "\nSpecify positive or negative delta input for Width [+/-] : "))
          (initget 5)
          (setq ddw (getdist "\nPick or specify delta Width value - for zero delta type \"0\" : "))
          (initget 1 "+ -")
          (setq opl (getkword "\nSpecify positive or negative delta input for Length [+/-] : "))
          (initget 5)
          (setq ddl (getdist "\nPick or specify delta Length value - for zero delta type \"0\" : "))
          (repeat (setq i (sslength ss))
            (setq rec (ssname ss (setq i (1- i))))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (car vrec) (cadr vrec)))
            (setq dn ((eval (read opw)) d ddw))
            (setq p2 (polar (car vrec) (angle (car vrec) (cadr vrec)) dn))
            (setq p3 (polar (cadddr vrec) (angle (cadddr vrec) (caddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) p2 p3 (cadddr vrec))))
            (setq pdxf (reverse (cdr (member (car vrec10n) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cadddr vrec10n) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (cadr vrec) (caddr vrec)))
            (setq dn ((eval (read opl)) d ddl))
            (setq p3 (polar (cadr vrec) (angle (cadr vrec) (caddr vrec)) dn))
            (setq p4 (polar (car vrec) (angle (car vrec) (cadddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) (cadr vrec) p3 p4)))
            (setq pdxf (reverse (cdr (member (car vrec10n) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cadddr vrec10n) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
          )
        )
      )
    )
    ( (eq ch "Single")
      (repeat (setq i (sslength ss))
        (setq rec (ssname ss (setq i (1- i))))
        (redraw rec 3)
        (initget 1 "WL SC DE")
        (setq op (getkword "\nChoose option (New Width-Length/Scale Width-Length/Delta Width-Length) [WL/SC/DE] : "))
        (cond
          ( (eq op "WL")
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq w (distance (car vrec) (cadr vrec)))
            (setq l (distance (cadr vrec) (caddr vrec)))
            (prompt "\nCurrent Width : ") (princ (rtos w 2 50)) (prompt "\tCurrent Length : ") (princ (rtos l 2 50))
            (initget 1 "+ -")
            (setq opw (getkword "\nSpecify positive or negative input for new Width [+/-] : "))
            (initget 4)
            (setq nw (getdist (strcat "\nPick or specify new Width value <" (rtos w 2 50) "> : ")))
            (if (null nw) (setq nw w))
            (setq nw ((eval (read opw)) 0.0 nw))
            (setq p2 (polar (car vrec) (angle (car vrec) (cadr vrec)) nw))
            (setq p3 (polar (cadddr vrec) (angle (cadddr vrec) (caddr vrec)) nw))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) p2 p3 (cadddr vrec))))
            (setq pdxf (reverse (cdr (member (car vrec10n) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cadddr vrec10n) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (initget 1 "+ -")
            (setq opl (getkword "\nSpecify positive or negative input for new Length [+/-] : "))
            (initget 4)
            (setq nl (getdist (strcat "\nPick or specify new Length value <" (rtos l 2 50) "> : ")))
            (if (null nl) (setq nl l))
            (setq nl ((eval (read opl)) 0.0 nl))
            (setq p3 (polar (cadr vrec) (angle (cadr vrec) (caddr vrec)) nl))
            (setq p4 (polar (car vrec) (angle (car vrec) (cadddr vrec)) nl))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) (cadr vrec) p3 p4)))
            (setq pdxf (reverse (cdr (member (car vrec10n) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cadddr vrec10n) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
          )
          ( (eq op "SC")
            (initget 3)
            (setq scfw (getreal "\nSpecify positive or negative Width scale factor : "))
            (initget 3)
            (setq scfl (getreal "\nSpecify positive or negative Length scale factor : "))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (car vrec) (cadr vrec)))
            (setq dn (* d scfw))
            (setq p2 (polar (car vrec) (angle (car vrec) (cadr vrec)) dn))
            (setq p3 (polar (cadddr vrec) (angle (cadddr vrec) (caddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) p2 p3 (cadddr vrec))))
            (setq pdxf (reverse (cdr (member (car vrec10n) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cadddr vrec10n) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (cadr vrec) (caddr vrec)))
            (setq dn (* d scfl))
            (setq p3 (polar (cadr vrec) (angle (cadr vrec) (caddr vrec)) dn))
            (setq p4 (polar (car vrec) (angle (car vrec) (cadddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) (cadr vrec) p3 p4)))
            (setq pdxf (reverse (cdr (member (car vrec10n) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cadddr vrec10n) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
          )
          ( (eq op "DE")
            (initget 1 "+ -")
            (setq opw (getkword "\nSpecify positive or negative delta input for Width [+/-] : "))
            (initget 5)
            (setq ddw (getdist "\nPick or specify delta Width value - for zero delta type \"0\" : "))
            (initget 1 "+ -")
            (setq opl (getkword "\nSpecify positive or negative delta input for Length [+/-] : "))
            (initget 5)
            (setq ddl (getdist "\nPick or specify delta Length value - for zero delta type \"0\" : "))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (car vrec) (cadr vrec)))
            (setq dn ((eval (read opw)) d ddw))
            (setq p2 (polar (car vrec) (angle (car vrec) (cadr vrec)) dn))
            (setq p3 (polar (cadddr vrec) (angle (cadddr vrec) (caddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) p2 p3 (cadddr vrec))))
            (setq pdxf (reverse (cdr (member (car vrec10n) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cadddr vrec10n) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (cadr vrec) (caddr vrec)))
            (setq dn ((eval (read opl)) d ddl))
            (setq p3 (polar (cadr vrec) (angle (cadr vrec) (caddr vrec)) dn))
            (setq p4 (polar (car vrec) (angle (car vrec) (cadddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) (cadr vrec) p3 p4)))
            (setq pdxf (reverse (cdr (member (car vrec10n) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cadddr vrec10n) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
          )
        )
        (redraw rec 4)
      )
    )
  )
  (princ)
)

 M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)
0 Likes
Message 5 of 21

marko_ribar
Advisor
Advisor

This site now doesn't allow me to edit my last post...

 

It should be - my appology :

 

(defun c:recedit ( / ch d ddl ddw dn i l nl nw op opl opw p2 p3 p4 pdxf rec scfl scfw sdxf ss ssn vrec vrec10n w )
  (prompt "\nSelect rectangles you want to edit...")
  (setq ss (ssget "_:L" '((0 . "LWPOLYLINE") (90 . 4) (-4 . "<or") (70 . 1) (70 . 129) (-4 . "or>"))))
  (while (or (not ss) (vl-some '(lambda ( x ) (eq x nil)) (mapcar '(lambda ( x ) (rectangle-p x 1e-8)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))))
    (prompt "\nEmpty sel.set or some of selected LWPOLYLINE(s) doesn't belong to rectangles... Try selecting rectangle(s) again...")
    (setq ss (ssget "_:L" '((0 . "LWPOLYLINE") (90 . 4) (-4 . "<or") (70 . 1) (70 . 129) (-4 . "or>"))))
    (if ss
      (progn
        (setq ssn (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
        (foreach e ssn
          (if (not (rectangle-p e 1e-8))
            (ssdel e ss)
          )
        )
      )
    )
  )
...

 HTH, M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)
0 Likes
Message 6 of 21

Kent1Cooper
Consultant
Consultant

@marko_ribar wrote:

What will you do with delta width and delta length values, Kent?

....


That's one of the easier parts to do [in a routine, of course -- you couldn't do it in the Properties Palette unless the current scale factors and the delta values are easy to combine in your head].  If the native Block is a one-unit square, then the X scale factor is its length, and the Y scale factor is its width [at least at 0 rotation and as the terms "length" and "width" are used in the Rectangle command's Dimensions option -- I would use X="width" and Y="height" if it were up to me].  If you want to use a delta value, you just get the appropriate current scale factor from the entity data or VLA properties, add/subtract the delta value to/from that, and impose the adjusted number back on it, either with (subst)/(entmod) or (vla-put...) methods.  No calculation of new vertex locations required.  Depending on whether you care which location in the Rectangle stays where it is, and where you've defined the insertion point in the Block definition, you might want to calculate a new insertion point for the Block reference, but that's only one positional calculation.

 

But it's all just a "consider the option" suggestion.  Whether it makes sense depends a lot on what the rectangles represent and what they need to be able to do with them [other than adjust their size] or get from them.  For instance, if they're Polylines, you can see their area or perimeter length directly in the Properties Palette just by picking on one, which you can't see with a Block.  Conversely, determining the area of such a Block in a routine would be much easier than with Polyline entity data -- just multiply its X and Y scale factors.  [There's a handy "Area" VLA property of Polylines that makes them easier in that regard if you go the (vla) route.]  And narrowing down a selection to actual Rectangles would be infinitely simpler -- just filter for Block name [no need to check quantity of vertices, or equality of alternate segment lengths, or comparative segment directions, or whether closed or not, or any of that].  And you can see the angle of a Block's orientation directly in its Properties, which you can't see about a Polyline.

Kent Cooper, AIA
0 Likes
Message 7 of 21

Anonymous
Not applicable

@marko_ribar
Thank you very much. Your skills are awesome!
I have a few questions:

1.
I don't know why, the horizontal dimension of Rectangle (which is its WIDTH)
is called "length", and
the horizontal dimension of Rectangle (which is its HEIGHT)
is called "width".
So, the WIDTH of Rectangle is mentioned as its length,
and the HEIGHT of Rectangle is called width of Rectangle.

2.
In the CommandLine, prompt "Choose option (New Width-Length/Scale Width-Length/Delta Width-Length) [WL/SC/DE] : "
is quite too long.
I think, that "Choose option (New/Scale/Delta Width-Length) [N/SC/DE] : "

3. I didn't think, that there's possibility to write lisp
which's command are displayed in InteractiveMenu.
And here's my question:
What are the commands which specify,
if the commands are displayed in CommandLine/ in InteractiveMenu/ in DialogBox?
For DialogBox, is that INITDIA, am I right?
For CommandLine, there's no special command - it's default option of displaying commands in AutoCad.
But what command gives order to display commands in InteractiveMenu?

4.
What is left in your lisp, that is option "Select Rectangles", which
allows the user to select multiple Rectangles
which Width-Height the user wants to change at once.
That is what I miss the best in your lisp.
You have the options "Select All Rectangles" and "Select Single Rectangle",
I think that instead of "Select Single Rectangle"
you could give "Select Rectangle(s): ".

5.
I think that the idea with +/- values of Width-Length is a little bit confusing.
While using them, I didn't know in which direction I change Width-Lenght.
But I learned, that "-" allows you to draw Width-Length
in direction opposite to this, in which is the Rectangle's side drawn.
I think, it would be better and more comfortable for the users,
if you use the same way, as is default in AutoCad:
Command: RECTANGLE
Specify first corner point or [Chamfer/Elevation/Fillet/Thickness/Width]:
Specify other corner point or [Area/Dimensions/Rotation]: d
Specify length for rectangles <21.0000>:
Specify width for rectangles <122.0000>:
Specify other corner point or [Area/Dimensions/Rotation]:
In this moment you choose a point on one of four possible directions.
You can see, how your Rectangle is look like.
And when I use your lisp I have to imagine and think,
how will be my Rectangle look like.
To be honest, this solution from Autocad is for me more comfortable
than the +/- option from your lisp.

6.
I didn't think, that as response I get so extended and broad lisp.
I think that for the users would be better,
not to use one command and every time have to choose one of three options,
but to have these three options in three separate lisps.
Examine:
What takes less time:
to type RECEDIT, Enter,
read prompt with three options,
watch, which option has which keyboard shortcut,
type DE, Enter,
or
to type for example RECDE for RECEDIT --> DElta option,
where is no need to read the prompt
and to type one of multiple options.

I hope I come up with editing your lisp to have three separate lisps
and to have possibility to select multiple Rectangles,
and to choose one of four possibilities of Rectangle's position.

7.
I am very impressed by your lisp.
I wanted only lisp for "Select Rectangle(s) to change their Width and Height: "
"Specify New Width for these Rectangle(s): "
"Specify New Height for these Rectangle(s): "
"Edit position of every Rectangle (Enter to not to change position of specified Rectangle): "
, and you write such a great lisp.
I have never thought about commands for "Scale Rectangle Dimensions"
and "Delta Rectangle Dimensions".
You have surprised me in very positive way.

Whoa, it's a long list, but you have my great estimation and respect.
You did very big, but good job.
Thank you very much once more.

0 Likes
Message 8 of 21

Kent1Cooper
Consultant
Consultant

@Anonymous wrote:

.....
I wanted only lisp for "Select Rectangle(s) to change their Width and Height: "
"Specify New Width for these Rectangle(s): "
"Specify New Height for these Rectangle(s): "
"Edit position of every Rectangle (Enter to not to change position of specified Rectangle): "
....


What do you mean by "not to change position" of a Rectangle?  If its width and/or height are changed, its "position" must change in some respect.  Do you mean to keep its midpoint in the same place [that would be my first assumption], in which case the position of at least some of its edges must change, or one of its corners [and if so, how to designate which one], or perhaps the middle of one of its edges, or... ?

 

And if the User chooses to "Edit position," how would that work?  Would they be asked for a new location individually for each one?  If so, again, what would be location relative to the Rectangle that would go at the selected new location?

Kent Cooper, AIA
0 Likes
Message 9 of 21

Anonymous
Not applicable

I meaned something like on the end of RECTANGLE command. When you type RECTANGLE, Enter, you pick Point which will be first corner of this Rectangle, then you type Length and Width (but these dimensions - I think so - should be called Width and Height), on the end you can choose one of four variants for position of the second Rectangle's corner.

I called it "position of the Rectangle". It was quite confusing.

0 Likes
Message 10 of 21

Kent1Cooper
Consultant
Consultant

@Anonymous wrote:

I meaned something like on the end of RECTANGLE command. .... you can choose one of four variants for position of the second Rectangle's corner.

....


I would suggest the phrase "change the quadrant" of the Rectangle for that, in place of "Edit the position".  If the User chooses to not change the quadrant, does that mean the original starting corner of the Rectangle should stay where it is, and other corners be adjusted from there for the new size?  If the User chooses to change the quadrant, I can picture it might be easier to erase the Rectangle and make a new one starting from the original starting corner, but if the original is not orthogonally oriented [as RECTANG always makes them], the new one would then need to be Rotated to match the original.  But it would be interesting to figure out how to ask for the quadrant they want if it's at an angle.

Kent Cooper, AIA
0 Likes
Message 11 of 21

Anonymous
Not applicable

The phrase "change the quadrant" of the Rectangle instead of "Edit the position" - yes, I should do so earlier, you are right. I simply hadn't right words in brain when I wrote my previous messages.

 

Hm, I didn't think about this case with rectangle at an angle. You are right, it would be interesting.

0 Likes
Message 12 of 21

marko_ribar
Advisor
Advisor

I am not sure if I followed all your conversations, but I ended with this 3 routines - first one added "WL" option for "All" case and added UCS aligment preview to better understand modifications of W/L that is to be made...

Similar I did and in my reccedit.lsp - only this new routine if refered for center rectangles position; also added "WL" for "All" and for "Single" UCS aligment preview...

And third small routine recc.lsp is made actually for drawing rectangles by center point... Couldn't find better way to acomplish this task than this - standard "RECTANGLE" command, and at the end move it so first picked point becomes rectangles center...

 

All should work in any UCS/View/Space...

 

HTH, M.R.

Regards and happy coding...

Marko Ribar, d.i.a. (graduated engineer of architecture)
0 Likes
Message 13 of 21

Anonymous
Not applicable

Lisp for " Draw Rectangle whichs CenterPoint is where you pick the first point."? Wow, that idea was yet not in my head. Thank you.

0 Likes
Message 14 of 21

Kent1Cooper
Consultant
Consultant

@marko_ribar wrote:

....

And third small routine recc.lsp is made actually for drawing rectangles by center point... Couldn't find better way to acomplish this task than this - standard "RECTANGLE" command, and at the end move it so first picked point becomes rectangles center...

....


Here's a routine that does that directly in-place -- RectMidPoint.lsp with its RMP command.  It does have a few limitations that I haven't yet figured out how to overcome [see comments at the top, and down where the D for Dimensions option occurs], but it includes the regular Rectangle command's Fillet and Chamfer and Width and Elevation and Thickness options, and draws the Rectangle dynamically as you move the cursor around, and so on.  [Also, I haven't yet updated its *error* function to remove the (command) function from it so Acad2015 won't complain.]

Kent Cooper, AIA
Message 15 of 21

marko_ribar
Advisor
Advisor

Kent, I personally think that your version is good, but not so applicable in real situations... If I should draw rectangle from its center, I would use recc.lsp posted above for keyboard inputs (Width/Length, Chamfers, Fillets, Thickness, Elevations) as my version is compatible with all UCS/Views/Spaces, while your is just good in WCS... For osnaps, I've just created my version of RMP.lsp that uses Lee Mac's GrSnap functions and it's also applicable in all situations (UCS/Views/Spaces)... I'll post my version so its beneficial to all that want to use it... I added my versions into my startup acaddoc.lsp and with my recedit.lsp and reccedit.lsp as also with 3pt-rectangle.lsp example that you can find on www.lee-mac.com (I have my version) I think I can create or modify rectangles in all kind of situations...

 

Very best regards and thanks for your also good routine Kent and happy coding...

M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)
0 Likes
Message 16 of 21

marko_ribar
Advisor
Advisor

Only now, after some testing I found that my previously posted recc.lsp was wrong... I've done tests with chamfers and fillets on which I totally forgot that actually do exist in original RECTANGLE command... So I've fixed my recc.lsp - it should be something like this... I hope that now it's all OK, but I am ready to hear if there is still something wrong...

 

Kind regards and sorry for inconvenience, M.R.

Happy coding...

Marko Ribar, d.i.a. (graduated engineer of architecture)
0 Likes
Message 17 of 21

Anonymous
Not applicable

I'm glad to hear that discussion I start was a point to do such great lisps.

Marko, thank you for telling about Lee mac's 3-Point-Rectangle lisp. It's a great thing, too.

0 Likes
Message 18 of 21

Anonymous
Not applicable
 
0 Likes
Message 19 of 21

marko_ribar
Advisor
Advisor

Hello Marko,

 

Thank you for posting your RECEDIT script to conveniantly resize rectangles.

I tried it, and I see, it offers

- option 1: scale the sides of the rectangle

- option 2: resize the sides using a value for the length difference

 

It seems however that it has no option to simply define the length of a side in total (by typing a value, e.g. "220" if you want the side to be 220 units long), without respect of how long the side was before.

 

However, my main problem is that on executing the script, an error appears. The script nicely gathers all the information (rectangle/s selected; desired values for the sides, etc.), but then on hitting the final "Return" key, it gets an error.

 

Here is the listing from the command window:

 

Command: recedit
Select rectangles you want to edit...
Select objects: 1 found
Select objects:
Process all rectangles or one by one [All/Single] <All> :
Choose option (Scale Width-Length/Delta Width-Length) [SC/DE] : de
Specify positive or negative delta input for Width [+/-] : +
Pick or specify delta Width value - for zero delta type "0" : 200
Specify positive or negative delta input for Length [+/-] : +
Pick or specify delta Length value - for zero delta type "0" : 200
Cannot invoke (command) from *error* without prior call to (*push-error-using-command*).
Converting (command) calls to (command-s) is recommended.
Command:

 

Perhaps you want to update your code?
Thank you very much!

______________________________________________________________________________________________

 

It's working for me on my ACAD 2014 (Win 7 - x64)...

It should modify rectangle to become square with edges exactly 200 units...

 

Is someone else experiencing something similar like your error message?

Marko Ribar, d.i.a. (graduated engineer of architecture)
0 Likes
Message 20 of 21

marko_ribar
Advisor
Advisor

Here is lisp in code tags - maybe something wrong with transfer of data...

Version I use :

 

(defun rectangle-p ( e f / nobulge-p dpar stp enp ptn k parpts index ptlst )

   (vl-load-com)

   (defun nobulge-p ( e i f )
      (apply 'and (mapcar '(lambda (x) (equal (vla-getbulge e x) 0.0 f)) i))
   )

   (setq dpar (/ (+ (abs (setq enp (vlax-curve-getendparam e))) (abs (setq stp (vlax-curve-getstartparam e)))) (setq ptn (cdr (assoc 90 (entget e))))))
   (setq k -1.0)
   (repeat ptn
      (setq parpts (append parpts (setq parpts (list (+ stp (* (setq k (1+ k)) dpar))))))
   )
   (setq k -1)
   (repeat ptn
      (setq index (append index (setq index (list (setq k (1+ k))))))
   )
   (setq ptlst (mapcar '(lambda (x) (vlax-curve-getpointatparam e x)) parpts))
   (and
      (eq ptn 4)
      (nobulge-p (if (eq (type e) 'ENAME) (vlax-ename->vla-object e) e) index f)
      (equal (distance (nth 0 ptlst) (nth 1 ptlst)) (distance (nth 2 ptlst) (nth 3 ptlst)) f)
      (equal (distance (nth 1 ptlst) (nth 2 ptlst)) (distance (nth 3 ptlst) (nth 0 ptlst)) f)
      (equal (distance (nth 0 ptlst) (nth 2 ptlst)) (distance (nth 1 ptlst) (nth 3 ptlst)) f)
   )
)

(defun c:recedit ( / alignucs2rec 2xucsprev ch d ddl ddw dn i l nl nw op opl opw p2 p3 p4 pdxf rec scfl scfw sdxf ss ssn vrec vrec10n w gr )

  (defun alignucs2rec ( rec / i vlst )

    (vl-load-com)

    (setq i -1)
    (repeat 4
      (setq vlst (cons (vlax-curve-getpointatparam rec (setq i (1+ i))) vlst))
    )
    (setq vlst (reverse vlst))
    (command "_.UCS" "_W")
    (command "_.UCS" "_3P" (car vlst) (cadr vlst) (cadddr vlst))
    (princ)
  )

  (defun 2xucsprev nil
    (command "_.UCS" "_P")
    (command "_.UCS" "_P")
    (princ)
  )

  (prompt "\nSelect rectangles you want to edit...")
  (setq ss (ssget "_:L" '((0 . "LWPOLYLINE") (90 . 4) (-4 . "<or") (70 . 1) (70 . 129) (-4 . "or>"))))
  (while (or (not ss) (vl-some '(lambda ( x ) (eq x nil)) (mapcar '(lambda ( x ) (rectangle-p x 1e-8)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))))
    (prompt "\nEmpty sel.set or some of selected LWPOLYLINE(s) doesn't belong to rectangles... Try selecting rectangle(s) again...")
    (setq ss (ssget "_:L" '((0 . "LWPOLYLINE") (90 . 4) (-4 . "<or") (70 . 1) (70 . 129) (-4 . "or>"))))
    (if ss
      (progn
        (setq ssn (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
        (foreach e ssn
          (if (not (rectangle-p e 1e-8))
            (ssdel e ss)
          )
        )
      )
    )
  )
  (initget "All Single")
  (setq ch (getkword "\nProcess all rectangles or one by one [All/Single] <All> : "))
  (if (null ch) (setq ch "All"))
  (cond
    ( (eq ch "All")
      (repeat (setq i (sslength ss))
        (setq rec (ssname ss (setq i (1- i))))
        (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
        (setq w (distance (car vrec) (cadr vrec)))
        (setq l (distance (cadr vrec) (caddr vrec)))
        (prompt "\nCurrent Width : ") (princ (rtos w 2 50)) (prompt "\tCurrent Length : ") (princ (rtos l 2 50))
      ) 
      (initget 1 "WL SC DE")
      (setq op (getkword "\nChoose option (New Width-Length/Scale Width-Length/Delta Width-Length) [WL/SC/DE] : "))
      (cond
        ( (eq op "WL")
          (initget 1 "+ -")
          (setq opw (getkword "\nSpecify positive or negative input for new Width [+/-] : "))
          (initget 5)
          (setq nw (getdist "\nPick or specify new Width value : "))
          (initget 1 "+ -")
          (setq opl (getkword "\nSpecify positive or negative input for new Length [+/-] : "))
          (initget 5)
          (setq nl (getdist "\nPick or specify new Length value : "))
          (repeat (setq i (sslength ss))
            (setq rec (ssname ss (setq i (1- i))))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq nw ((eval (read opw)) 0.0 nw))
            (setq nl ((eval (read opl)) 0.0 nl))
            (setq p2 (polar (car vrec) (angle (car vrec) (cadr vrec)) nw))
            (setq p3 (polar (cadddr vrec) (angle (cadddr vrec) (caddr vrec)) nw))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) p2 p3 (cadddr vrec))))
            (setq pdxf (reverse (cdr (member (cons 10 (car vrec)) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cons 10 (cadddr vrec)) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq p3 (polar (cadr vrec) (angle (cadr vrec) (caddr vrec)) nl))
            (setq p4 (polar (car vrec) (angle (car vrec) (cadddr vrec)) nl))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) (cadr vrec) p3 p4)))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
          )
        )
        ( (eq op "SC")
          (initget 3)
          (setq scfw (getreal "\nSpecify positive or negative Width scale factor : "))
          (initget 3)
          (setq scfl (getreal "\nSpecify positive or negative Length scale factor : "))
          (repeat (setq i (sslength ss))
            (setq rec (ssname ss (setq i (1- i))))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (car vrec) (cadr vrec)))
            (setq dn (* d scfw))
            (setq p2 (polar (car vrec) (angle (car vrec) (cadr vrec)) dn))
            (setq p3 (polar (cadddr vrec) (angle (cadddr vrec) (caddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) p2 p3 (cadddr vrec))))
            (setq pdxf (reverse (cdr (member (cons 10 (car vrec)) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cons 10 (cadddr vrec)) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (cadr vrec) (caddr vrec)))
            (setq dn (* d scfl))
            (setq p3 (polar (cadr vrec) (angle (cadr vrec) (caddr vrec)) dn))
            (setq p4 (polar (car vrec) (angle (car vrec) (cadddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) (cadr vrec) p3 p4)))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
          )
        )
        ( (eq op "DE")
          (initget 1 "+ -")
          (setq opw (getkword "\nSpecify positive or negative delta input for Width [+/-] : "))
          (initget 5)
          (setq ddw (getdist "\nPick or specify delta Width value - for zero delta type \"0\" : "))
          (initget 1 "+ -")
          (setq opl (getkword "\nSpecify positive or negative delta input for Length [+/-] : "))
          (initget 5)
          (setq ddl (getdist "\nPick or specify delta Length value - for zero delta type \"0\" : "))
          (repeat (setq i (sslength ss))
            (setq rec (ssname ss (setq i (1- i))))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (car vrec) (cadr vrec)))
            (setq dn ((eval (read opw)) d ddw))
            (setq p2 (polar (car vrec) (angle (car vrec) (cadr vrec)) dn))
            (setq p3 (polar (cadddr vrec) (angle (cadddr vrec) (caddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) p2 p3 (cadddr vrec))))
            (setq pdxf (reverse (cdr (member (cons 10 (car vrec)) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cons 10 (cadddr vrec)) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (cadr vrec) (caddr vrec)))
            (setq dn ((eval (read opl)) d ddl))
            (setq p3 (polar (cadr vrec) (angle (cadr vrec) (caddr vrec)) dn))
            (setq p4 (polar (car vrec) (angle (car vrec) (cadddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) (cadr vrec) p3 p4)))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
          )
        )
      )
    )
    ( (eq ch "Single")
      (repeat (setq i (sslength ss))
        (setq rec (ssname ss (setq i (1- i))))
        (alignucs2rec rec)
        (redraw rec 3)
        (prompt "\nNext vertex/Finish (any key or left mouse click/ENTER or SPACE or right mouse click)")
        (while (not (or (equal (setq gr (grread nil)) '(2 32)) (equal gr '(2 13)) (eq (car gr) 11) (eq (car gr) 25)))
          (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
          (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (cadr vrec) (caddr vrec) (cadddr vrec) (car vrec))))
          (setq pdxf (reverse (cdr (member (cons 10 (car vrec)) (reverse (entget rec))))))
          (setq sdxf (cdr (member (cons 10 (cadddr vrec)) (entget rec))))
          (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
          (2xucsprev)
          (alignucs2rec rec)
          (redraw rec 3)
        )
        (initget 1 "WL SC DE")
        (setq op (getkword "\nChoose option (New Width-Length/Scale Width-Length/Delta Width-Length) [WL/SC/DE] : "))
        (cond
          ( (eq op "WL")
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq w (distance (car vrec) (cadr vrec)))
            (setq l (distance (cadr vrec) (caddr vrec)))
            (prompt "\nCurrent Width : ") (princ (rtos w 2 50)) (prompt "\tCurrent Length : ") (princ (rtos l 2 50))
            (initget 1 "+ -")
            (setq opw (getkword "\nSpecify positive or negative input for new Width [+/-] : "))
            (initget 4)
            (setq nw (getdist (strcat "\nPick or specify new Width value <" (rtos w 2 50) "> : ")))
            (if (null nw) (setq nw w))
            (setq nw ((eval (read opw)) 0.0 nw))
            (setq p2 (polar (car vrec) (angle (car vrec) (cadr vrec)) nw))
            (setq p3 (polar (cadddr vrec) (angle (cadddr vrec) (caddr vrec)) nw))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) p2 p3 (cadddr vrec))))
            (setq pdxf (reverse (cdr (member (cons 10 (car vrec)) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cons 10 (cadddr vrec)) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
            (redraw rec 3)
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (initget 1 "+ -")
            (setq opl (getkword "\nSpecify positive or negative input for new Length [+/-] : "))
            (initget 4)
            (setq nl (getdist (strcat "\nPick or specify new Length value <" (rtos l 2 50) "> : ")))
            (if (null nl) (setq nl l))
            (setq nl ((eval (read opl)) 0.0 nl))
            (setq p3 (polar (cadr vrec) (angle (cadr vrec) (caddr vrec)) nl))
            (setq p4 (polar (car vrec) (angle (car vrec) (cadddr vrec)) nl))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) (cadr vrec) p3 p4)))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
          )
          ( (eq op "SC")
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq w (distance (car vrec) (cadr vrec)))
            (setq l (distance (cadr vrec) (caddr vrec)))
            (prompt "\nCurrent Width : ") (princ (rtos w 2 50)) (prompt "\tCurrent Length : ") (princ (rtos l 2 50))
            (initget 3)
            (setq scfw (getreal "\nSpecify positive or negative Width scale factor : "))
            (initget 3)
            (setq scfl (getreal "\nSpecify positive or negative Length scale factor : "))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (car vrec) (cadr vrec)))
            (setq dn (* d scfw))
            (setq p2 (polar (car vrec) (angle (car vrec) (cadr vrec)) dn))
            (setq p3 (polar (cadddr vrec) (angle (cadddr vrec) (caddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) p2 p3 (cadddr vrec))))
            (setq pdxf (reverse (cdr (member (cons 10 (car vrec)) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cons 10 (cadddr vrec)) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
            (redraw rec 3)
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (cadr vrec) (caddr vrec)))
            (setq dn (* d scfl))
            (setq p3 (polar (cadr vrec) (angle (cadr vrec) (caddr vrec)) dn))
            (setq p4 (polar (car vrec) (angle (car vrec) (cadddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) (cadr vrec) p3 p4)))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
          )
          ( (eq op "DE")
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq w (distance (car vrec) (cadr vrec)))
            (setq l (distance (cadr vrec) (caddr vrec)))
            (prompt "\nCurrent Width : ") (princ (rtos w 2 50)) (prompt "\tCurrent Length : ") (princ (rtos l 2 50))
            (initget 1 "+ -")
            (setq opw (getkword "\nSpecify positive or negative delta input for Width [+/-] : "))
            (initget 5)
            (setq ddw (getdist "\nPick or specify delta Width value - for zero delta type \"0\" : "))
            (initget 1 "+ -")
            (setq opl (getkword "\nSpecify positive or negative delta input for Length [+/-] : "))
            (initget 5)
            (setq ddl (getdist "\nPick or specify delta Length value - for zero delta type \"0\" : "))
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (car vrec) (cadr vrec)))
            (setq dn ((eval (read opw)) d ddw))
            (setq p2 (polar (car vrec) (angle (car vrec) (cadr vrec)) dn))
            (setq p3 (polar (cadddr vrec) (angle (cadddr vrec) (caddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) p2 p3 (cadddr vrec))))
            (setq pdxf (reverse (cdr (member (cons 10 (car vrec)) (reverse (entget rec))))))
            (setq sdxf (cdr (member (cons 10 (cadddr vrec)) (entget rec))))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
            (redraw rec 3)
            (setq vrec (mapcar 'cdr (acet-list-m-assoc 10 (entget rec))))
            (setq d (distance (cadr vrec) (caddr vrec)))
            (setq dn ((eval (read opl)) d ddl))
            (setq p3 (polar (cadr vrec) (angle (cadr vrec) (caddr vrec)) dn))
            (setq p4 (polar (car vrec) (angle (car vrec) (cadddr vrec)) dn))
            (setq vrec10n (mapcar '(lambda ( x ) (cons 10 x)) (list (car vrec) (cadr vrec) p3 p4)))
            (entupd (cdr (assoc -1 (entmod (append pdxf vrec10n sdxf)))))
          )
        )
        (redraw rec 4)
        (2xucsprev)
      )
    )
  )
  (princ)
)
Marko Ribar, d.i.a. (graduated engineer of architecture)
0 Likes