Automatically convert rectangle into concave arcs with a known degree

[noormuhammad295k]

I am wanting to automatically convert all sides of a rectangle drawn by the user into concave arcs (about 10 degrees all around). I found this wonderful routine written by Marko Ribar (sorry if that's not correct credit) that does exactly what I'm looking for, except that the user has to manually define direction and degree of the arcs using the mouse. Push mouse positive Y direction = convex. Pull mouse negative Y direction = concave (which is what I want). Does anyone know how to add code to automatically pull in the negative Y direction about 10 degrees once rectangle is selected? Is there an easier way to accomplish this task by just making 10 degree arcs instead of lines when drawing a rectangle? 

;Code to convert rectangle lines into arcs:

(defun c:lwstraight2arced ( / nthmassocsubst lw enx vs gr enxb p b i pt1 pt2 pt3 pt4 myrec )

;My added code to draw a rectangle by the user picking two opposite corners-----------------
(setq pt1 (getpoint "\nEnter first corner: "))
(setq pt3 (getcorner pt1 "\nEnter cross corner: "))
(setq pt2 (list (car pt1) (cadr pt3)))
(setq pt4 (list (car pt3) (cadr pt1)))
(setq myrec (command "rectangle" pt1 pt3 ""))
;end of my added code------------------------


  (defun nthmassocsubst ( n key value lst / k slst p j plst m tst pslst )
    (setq k (length (setq slst (member (assoc key lst) lst))))
    (setq p (- (length lst) k))
    (setq j -1)
    (repeat p
      (setq plst (cons (nth (setq j (1+ j)) lst) plst))
    )
    (setq plst (reverse plst))
    (setq j -1)
    (setq m -1)
    (repeat k
      (setq j (1+ j))
      (if (equal (assoc key (member (nth j slst) slst)) (nth j slst) 1e-6)
        (setq m (1+ m))
      )
      (if (and (not tst) (= n m))
        (setq pslst (cons (cons key value) pslst) tst t)
        (setq pslst (cons (nth j slst) pslst))
      )
    )
    (setq pslst (reverse pslst))
    (append plst pslst)
  )

;
; ----removed original code that has user select a line or rectangle manually-----
;          (setq lw (car (entsel "\nPick LWPOLYLINE straight polygon...")))
;-----end of original code-----



;-------My new code to have a previously drawn rectangle above automatically selected-----------------------------------
            (setq lw (entlast))
;-----End of my new code------


  (setq enx (entget lw))
  (setq vs (getvar 'viewsize))
  (while (= 5 (car (setq gr (grread t))))
    (setq enxb (acet-list-m-assoc 42 enx))
    (setq p (cadr gr))
    (setq b (/ (cadr p) vs))
    (setq i -1)
    (foreach dxf42 enxb
      (setq enx (nthmassocsubst (setq i (1+ i)) 42 b enx))
    )
    (entupd (cdr (assoc -1 (entmod enx))))
  )
  (princ)
)

Here is what I hope to achieve once a rectangle is drawn by the user. A slightly concaved rectangle without user input.

[SCREEN SHOT ATTACHED] DeepmaterialJp 

I have added to the routine the following steps:

-Get area of rectangle by multiplying length by width. -Draw circles and rectangles with a specific size at each corner based on square footage of rectangle in inches.

Here is the working code with the additions above:

(defun c:concavearc ( / b p q s z myrecarea convertrecarea pt1 pt2 pt3 pt4 circleset24 circleset36 circleset48)
; Create concave arcs from a rectangle
(setq s 20.0) ;; Arc sagitta

(if (and (setq p (getpoint "\nSpecify first corner: "))
(setq q ((if (zerop (getvar 'worlducs)) getpoint getcorner) p "\nSpecify opposite corner: "))
(mapcar 'set '(p q) (mapcar '(lambda ( x ) (mapcar x p q)) '(min max)))
(setq z (trans '(0 0 1) 1 0 t)
b (mapcar '(lambda ( a b c ) (/ s (- a b) -0.5)) q p '(0 0))
)
)
(entmake
(list
'(000 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(090 . 4)
'(070 . 1)
(cons 010 (trans p 1 z))
(cons 042 (car b))
(cons 010 (trans (list (car q) (cadr p)) 1 z))
(cons 042 (cadr b))
(cons 010 (trans q 1 z))
(cons 042 (car b))
(cons 010 (trans (list (car p) (cadr q)) 1 z))
(cons 042 (cadr b))
(cons 210 z)
)
)
)

;Add width of 2" and dashed line to arc polyline -----------------------------------------

(setvar "cmdecho" 0); disable command echo
(setq Plnwdth (ssget "L"));get last entity
(command "pedit" Plnwdth "W" 2 "");set last entity width to 2

(if (null (tblsearch "ltype" "dashed"))
(command ".linetype" "load" "dashed" "acad.lin" "")
)

(command "change" Plnwdth "" "p" "LType" "Dashed" "" "ltScale" "30" "");lynetype
(setvar "cmdecho" 1); restore command echo
;end add width of 2 to arc polyline-----------------------------------------

;End concave arcs-----------------------------------------

;Setting corners of rectangle to variables --------------------------------------------------------------

; Get the four points of rectangle drawn by user above
(setq pt1 p)
(setq pt3 q)
(setq pt2 (list (car pt1) (cadr pt3)))
(setq pt4 (list (car pt3) (cadr pt1)))
(setq mylength (distance pt1 pt2)); length
(setq mywidth (distance pt1 pt4)); width
(setq myrecarea (* mylength mywidth)); Get area of rectangle (length x width)

(setvar "unitmode" 1);units to be displayed as entered
(setq convertrecarea (rtos myrecarea 4 2)); converts "convertrecarea" string into architectural format:

; Change units from decimal to Architectural
(if *decimal*
(progn
(command "_.-units" "2" "" "" "" "" "")
(setq *decimal* nil)
)
(progn
(command "_.-units" "4" "" "" "" "" "")
(setq *decimal* t)
)
)

; create conditional "if/and" functions based on rectangle area in square inches.
; if area of rectangle below 14400 SQ.Inches, give message to redraw rectangle
(if
(<= myrecarea 14400)
(prompt "Area to small. Redraw area again")
); End IF
; if area of rectangle is between 14401 SQ.Inches and 57600 SQ.Inches, place a 24" circle at each corner of rectangle points

(if
(and
(>= myrecarea 14401)
(<= myrecarea 57600)
); End AND
(progn
(command "-color" "t" "99,100,102" ""); Change color
(command "circle" pt1 "d" 24 0 ""); Create circle
(command "_copy" "last" "" "M" pt1 pt2 pt3 pt4 ""); Copy circle to all four points of rectangle
(setq circleset24 (ssget "_C" pt1 pt3 '((0 . "CIRCLE")))); Create selection set of circles using fencing around rectangle
(command "_hatch" "p" "AR-Conc" "2" "0" "s" circleset24 ""); Hatch selected circles

;Create rectangle from centerpoint. Copy to each corner
(command "-color" "t" "255,255,255" "")
(setq len 2)
(setq wid 2)
(setq z1 (trans '(0 0 1) 1 0 t))
(if (setq cnt1 pt1)
(entmake
(list
'(000 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(090 . 4)
'(070 . 1)
(cons 010 (trans (mapcar '+ cnt1 '(-2 -2)) 1 z1))
(cons 010 (trans (mapcar '+ cnt1 '( 2 -2)) 1 z1))
(cons 010 (trans (mapcar '+ cnt1 '( 2 2)) 1 z1))
(cons 010 (trans (mapcar '+ cnt1 '(-2 2)) 1 z1))
(cons 210 z1)

)
)
)
(command "_copy" "last" "" "M" pt1 pt2 pt3 pt4 "")

); End Progn
); End IF

; if area of rectangle is between 57601 SQ.Inches and 129600 SQ.Inches, place a 36" circle at each corner of rectangle points
(if
(and
(>= myrecarea 57601)
(<= myrecarea 129600)
); End AND
(progn
(command "-color" "t" "99,100,102" "")
(command "circle" pt1 "d" 36 0 "")
(command "_copy" "last" "" "M" pt1 pt2 pt3 pt4 "")
(setq circleset36 (ssget "_C" pt1 pt3 '((0 . "CIRCLE"))))
(command "_hatch" "p" "AR-Conc" "2" "0" "s" circleset36 "")

;Create rectangle from centerpoint. Copy to each corner
(command "-color" "t" "255,255,255" "")
(setq len 3)
(setq wid 3)
(setq z1 (trans '(0 0 1) 1 0 t))
(if (setq cnt1 pt1)
(entmake
(list
'(000 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(090 . 4)
'(070 . 1)
(cons 010 (trans (mapcar '+ cnt1 '(-3 -3)) 1 z1))
(cons 010 (trans (mapcar '+ cnt1 '( 3 -3)) 1 z1))
(cons 010 (trans (mapcar '+ cnt1 '( 3 3)) 1 z1))
(cons 010 (trans (mapcar '+ cnt1 '(-3 3)) 1 z1))
(cons 210 z1)

)
)
)
(command "_copy" "last" "" "M" pt1 pt2 pt3 pt4 "")

); End Progn
); End IF

; if area of rectangle is between 129601 SQ.Inches and 230400 SQ.Inches, place a 48" circle at each corner of rectangle points

(if
(and
(>= myrecarea 129601)
(<= myrecarea 230400)
); End AND
(progn
(command "-color" "t" "99,100,102" "")
(command "circle" pt1 "d" 48 0 "")
(command "_copy" "last" "" "M" pt1 pt2 pt3 pt4 "")
(setq circleset48 (ssget "_C" pt1 pt3 '((0 . "CIRCLE"))))
(command "_hatch" "p" "AR-Conc" "2" "0" "s" circleset48 "")

;Create rectangle from centerpoint. Copy to each corner
(command "-color" "t" "255,255,255" "")
(setq len 4)
(setq wid 4)
(setq z1 (trans '(0 0 1) 1 0 t))
(if (setq cnt1 pt1)
(entmake
(list
'(000 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(090 . 4)
'(070 . 1)
(cons 010 (trans (mapcar '+ cnt1 '(-4 -4)) 1 z1))
(cons 010 (trans (mapcar '+ cnt1 '( 4 -4)) 1 z1))
(cons 010 (trans (mapcar '+ cnt1 '( 4 4)) 1 z1))
(cons 010 (trans (mapcar '+ cnt1 '(-4 4)) 1 z1))
(cons 210 z1)

)
)
)
(command "_copy" "last" "" "M" pt1 pt2 pt3 pt4 "")

); End Progn
); End IF

; if area of rectangle is above 230401 SQ.Inches tell user to redraw area

(if
(>= myrecarea 230401)
(prompt "Area to big. Redraw area again")
); End IF
(princ convertrecarea)

);End "concavearc"
The new addition is working but I would like to be able to do the following:

Put the Arc segment of code inside an "IF" Statement so if rectangle drawn by user is too big or too small, prompt user "Out of range" and end routine. Right now, it draws the arcs regardless if out of range.

I tried to put in an IF statement below but didn't work. Here is a snippet of that:

(defun c:concavearc ( / b p q s z myrecarea convertrecarea pt1 pt2 pt3 pt4)

; ------------------ Create concave arcs from a rectangle----------
(setq s 20.0) ;; Arc sagitta

(if (and (setq p (getpoint "\nSpecify first corner: "))
(setq q ((if (zerop (getvar 'worlducs)) getpoint getcorner) p "\nSpecify opposite corner: "))

; Get the four points of rectangle drawn by user above
(setq pt1 p)
(setq pt3 q)
(setq pt2 (list (car pt1) (cadr pt3)))
(setq pt4 (list (car pt3) (cadr pt1)))
(setq mylength (distance pt1 pt2)); length
(setq mywidth (distance pt1 pt4)); width
(setq myrecarea (* mylength mywidth)); Get area of rectangle (length x width)


; If area drawn is above 129601square inches or below 14400 square inches display message the "not in range". Else, draw concave arcs.
(if
(and
(>= myrecarea 129601)
(<= myrecarea 14400)
); End and
(prompt "Not in range. Redraw area again")

(progn
Concave Arc code here....

);End Progn
);End "if/and" conditional statement
);End "get points"
Just as an internal issue. How do you put in numbers for Square feet rather than inches?

Example:

(<= myrecarea 14400)
into

(<= myrecarea 100 Sq. Ft.)

[Valentin_CAD]

@noormuhammad295k ,

You will find better results on Visual LISP, AutoLISP and General Customization Forum?

[Kent1Cooper]

---

@noormuhammad295k wrote:

I am wanting to automatically convert all sides of a rectangle drawn by the user into concave arcs (about 10 degrees all around). .... Is there an easier way to accomplish this task by just making 10 degree arcs instead of lines when drawing a rectangle? ....

---

In basic terms, try this [minimally tested]:

(defun C:CR10 ; = Concave Rectangle with 10-degree-sweep arc segments
  (/ edata edataorig area)
  (command "_.rectang" "_fillet" 0 "_chamfer" 0 0 pause pause)
  (setq
    edata (entget (entlast))
    edataorig edata
    area (getpropertyvalue (entlast) "area")
  ); setq
  (repeat 4 (setq edata (subst '(42 . 0.0436609) '(42 . 0.0) edata)))
  (entmod edata)
  (if (> (getpropertyvalue (entlast) "area") area); bulged outward
    (progn
      (setq edata edataorig)
      (repeat 4 (setq edata (subst '(42 . -0.0436609) '(42 . 0.0) edata)))
      (entmod edata)
    ); progn
  ); if
  (princ)
); defun

That assumes you draw the Rectangle simply by picking opposite corners.  If other possibilities may be needed, they can probably be accounted for.

[ronjonp]

Here's a quick one .. does not check direction but works in my test drawing using the rectangle command.

(defun c:foo (/ s)
  ;; RJP » 2021-07-20
  (if (setq s (ssget ":L" '((0 . "LWPOLYLINE") (90 . 4))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (entmod (mapcar '(lambda (x)
			 (if (= 42 (car x))
			   '(42 . 0.045)
			   x
			 )
		       )
		      (entget e)
	      )
      )
      ;; Uncomment these two lines to create arcs and delete the polyline
      ;; (vla-explode (vlax-ename->vla-object e))
      ;; (entdel e)
    )
  )
  (princ)
)

[john.uhden]

Yes.

One must just assign the bulge for each segment based on the chord and included angle.

If the polyline is CCW then the bulges must be negative, and vice versa.

[Sea-Haven]

Cool, removed the 90 . 4 got interesting answer on random shapes it does depend on CCW for which way curves are drawn.

[Kent1Cooper]

---

@Kent1Cooper wrote:

---

@noormuhammad295k wrote:

.... Is there an easier way to accomplish this task by just making 10 degree arcs instead of lines when drawing a rectangle? ....

---

....

(defun C:CR10 ; = Concave Rectangle with 10-degree-sweep arc segments
....

---

To demonstrate that it does it when drawing a rectangle, rather than converting rectangles already drawn:

 

[Sea-Haven]

Thought I would have a go the entmake could be better. A -ve angle is inside.

; curved pline box
; By AlanH July 2021

(defun dtr (a)
(* pi (/ a 180.0))
)

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)

(defun c:curbox ( / pt pt1 pt2 pt3 pt4 len wid ang lst)

(setq pt1 (getpoint "\nPick lower left"))
(setvar 'osmode 0)
(if (not AH:getvalsm)(load "Multi Getvals.lsp"))
(setq ans (AH:getvalsm (list "Simple rectang" "Enter length" 8 7 "1" "Enter height " 8 7 "2" "Enter angle " 8 7 "10")))

(setq Len (atof (nth 0 ans)))
(setq Wid (atof (nth 1 ans)))
(setq ang (/ (dtr (atof (nth 2 ans))) 4.0))

(setq pt2 (polar pt1 0.0 Len))
(setq pt3 (polar pt2 (/ pi 2.0) Wid))
(setq pt4 (polar pt1 (/ pi 2.0) Wid))

(setq lst (list pt1 pt2 pt3 pt4))

(entmake (list (cons 0 "POLYLINE")(cons 8 "0")(cons 66 1)(cons 70 1)))
(foreach pt lst
(entmake (list (cons 0 "VERTEX")(cons 10 pt)(cons 42 ang)))
)
(entmake (list (cons 0 "SEQEND")))

(setvar 'osmode oldsnap)

(princ)

)
(c:curbox)

[Kent1Cooper]

I didn't realize before that (subst) replaces all instances of what is to be replaced in the list.  [I was thinking of the way (vl-string-subst) works, replacing only the first instance.]  That simplifies my code a little.  But I've also revised some other things.  This new version lets you create the initial un-bulged rectangle using any of the options in the RECTANG command [Chamfer/Elevation/Fillet/Thickness/Width, Area/Dimensions/Rotation], then applies the 10-degree-swing concave curvature to all line segments in the result.  You can do things like these, directly within the command [Fillet option on the left, Chamfer in the middle, Width and Rotation on the right]:

(defun C:CR10 ; = Concave Rectangle with 10-degree-sweep arc segments
  (/ edata edataorig area)
  (command-s "_.rectang")
  (setq
    edata (entget (entlast))
    edataorig edata
    area (getpropertyvalue (entlast) "area")
  ); setq
  (entmod (subst '(42 . 0.0436609429) '(42 . 0.0) edata))
  (if (> (getpropertyvalue (entlast) "area") area); bulged outward
    (progn
      (setq edata edataorig); restore un-bulged
      (entmod (subst '(42 . -0.0436609429) '(42 . 0.0) edata))
    ); progn
  ); if
  (princ)
); defun

And un-like @Sea-Haven's code in Message 8, you can start at any corner you want, and it makes the same kind of object as the regular RECTANG command [a "lightweight" Polyline, not a "heavy" one].