Topic: square to circle lisp

[Kerry]

how is the square constructed ??

lines ?
lwpline, closed ?
other ?

I assume they are NOT all normal to world X & Y ?

Circle on current layer, or same as square ??

[Kerry]

Give this a run :
I want 5 cents each pier !!.

Code: [Select]


(DEFUN c:test (/ *error* oSquare)
  (DEFUN *error* (msg /)
    ;;(SETQ kbsg:debug_on T)
    (KBSF:ON-ERROR msg)
  )
  (VLA-ENDUNDOMARK KBSG:ACTIVEDOC)                          ; end any open undo group
  (VLA-STARTUNDOMARK KBSG:ACTIVEDOC)                        ; start new group
  ;;---------------------------------------
  (IF (= "AcDbPolyline"
         (VLA-GET-OBJECTNAME
           (SETQ oSquare (VLAX-ENAME->VLA-OBJECT
                           (AI_ASELECT1 "Select PolyLine Square To replace with Circle")
                         )
           )
         )
      )
    (PROGN (VLA-ADDCIRCLE KBSG:MODELSPACE
                          (VLAX-3D-POINT (MAPCAR '(LAMBDA (ord1 ord2) (* (+ ord1 ord2) 0.5))
                                                 (KBSF:LISP-VALUE (VLA-GET-COORDINATE oSquare 0))
                                                 (KBSF:LISP-VALUE (VLA-GET-COORDINATE oSquare 2))
                                         )
                          )
                          (* 0.5
                             (DISTANCE (KBSF:LISP-VALUE (VLA-GET-COORDINATE oSquare 0))
                                       (KBSF:LISP-VALUE (VLA-GET-COORDINATE oSquare 1))
                             )
                          )
           )
           (VLA-DELETE oSquare)
           (VLAX-RELEASE-OBJECT oSquare)
    )
  )
  (PRINC)
)


Library Stuff as helpers :

Code: [Select]


(VL-LOAD-COM)
(OR KBSG:ACADAPP (SETQ KBSG:ACADAPP (VLAX-GET-ACAD-OBJECT)))
(OR KBSG:ACTIVEDOC (SETQ KBSG:ACTIVEDOC (VLA-GET-ACTIVEDOCUMENT KBSG:ACADAPP)))
(OR KBSG:MODELSPACE (SETQ KBSG:MODELSPACE (VLA-GET-MODELSPACE KBSG:ACTIVEDOC)))
;;;==============================================
;;; Modified version of lisp-value : Original Author : Vladimir Nesterovsky 2002

(DEFUN KBSF:LISP-VALUE (val)
  (COND ((= (TYPE val) 'VARIANT) (KBSF:LISP-VALUE (VARIANT-VALUE val)))
        ((= (TYPE val) 'SAFEARRAY)
         (MAPCAR 'KBSF:LISP-VALUE (SAFEARRAY-VALUE val))
        )
        (T val)
  )
)
;;;==============================================
;;;==============================================

(DEFUN KBSF:ON-ERROR (msg / tmp)
  ;;----- Cancel any Active Commands -----------------------------  
  (WHILE (< 0 (GETVAR "cmdactive")) (COMMAND))
  ;;-----
  (VLA-SETVARIABLE KBSG:ACTIVEDOC "menuecho" 1)
  (VLA-ENDUNDOMARK KBSG:ACTIVEDOC)
  ;;----- Display error message if applicable _-------------------
  (COND ((NOT msg))                                         ; no error, do nothing
        ((VL-POSITION (STRCASE msg T)                       ; cancel
                      '("console break" "function cancelled" "quit / exit abort")
         )
        )
        ((PRINC (STRCAT "\nApplication Error: "
                        (ITOA (KBSF:LISP-VALUE (VLA-GETVARIABLE KBSG:ACTIVEDOC "errno")))
                        " :- "
                        msg
                )
         )
         (IF kbsg:debug_on
           (VL-BT)
         )
        )
  )
  (VLA-SETVARIABLE KBSG:ACTIVEDOC "errno" 0)
  ;;----- Display backtrace if in debug mode ---------------------
  ;;----- Release Bound Activex Objects --------------------------
  (FOREACH varname kbsg:objectsbound
    (IF (= (TYPE (SETQ tmp (VL-SYMBOL-VALUE varname))) 'vla-object)
      (IF (NOT (VLAX-OBJECT-RELEASED-P tmp))
        (VLAX-RELEASE-OBJECT tmp)
      )
    )
    (SET varname nil)
  )
  ;;----- Reset System Variables from global list ----------------
  (FOREACH item kbsg:sysvarlist (SETVAR (CAR item) (CADR item)))
  (SETQ kbsg:sysvarlist nil
        kbsg:objectsbound nil
  )
  (PRINC)
)
;;;==============================================
;;;==============================================

[CAB]

Here is my decoded version of the earlier post.

Code: [Select]

(defun c:sq2circle ()
  ;;return: T if closed, nil otherwise
  (defun ispolyclosed (elist)
    (= 1 (logand 1 (cdr (assoc 70 (entget elist)))))
  )
  (defun get_vertex (elist)
    (mapcar 'cdr
    (vl-remove-if-not
      '(lambda (x) (= (car x) 10)) elist))
  )
  ;;  ==============  START  ==================
  (if (and (setq sq (entsel "\nSelect square to convert to a circle."))
           (= (cdr (assoc 0 (setq entlst (entget (setq ent (car sq))))))
              "LWPOLYLINE")
           (= (length (setq clst (get_vertex entlst))) 4)
           (ispolyclosed ent)
      )
    (progn
      ;;========================================================
      (setq rflag 1) ; radius flag
      (cond
        ((= rflag 0);  Radius is endpoint of rectangle
         (setq rad (/ (distance (nth 0 clst) (nth 2 clst)) 2))
        )
        ((= rflag 1);  radius is closest side
         (setq rad (/ (min (distance (nth 0 clst) (nth 1 clst))
                           (distance (nth 1 clst) (nth 2 clst)))2))
        )
        ((= rflag 2);  radius is farthest side
         (setq rad (/ (max (distance (nth 0 clst) (nth 1 clst))
                           (distance (nth 1 clst) (nth 2 clst)))2))
        )
        ((= rflag 3);  match area of rectangle
         ;(setq rad ( * (sqrt ( * (distance (nth 0 clst) (nth 1 clst))
         ;                        (distance (nth 1 clst) (nth 2 clst)))
         ;                    ) 0.564))
         (setq rad (/(sqrt(/( * (distance (nth 0 clst) (nth 1 clst))
                                (distance (nth 1 clst) (nth 2 clst)))
                          (/ pi 4))) 2))
        )
      )
      ;;========================================================
      (setq cen (polar (nth 0 clst)
                       (angle (nth 0 clst) (nth 2 clst))
                       (/ (distance (nth 0 clst) (nth 2 clst)) 2))
      )
      (setq opts (list (cons 0 "CIRCLE")
                       (cons 8 (cdr (assoc 8 entlst))))
      )
      (if (setq lntyp (assoc 6 entlst))
        (setq opts (append opts (list (cons 6 (cdr lntyp)))))
      )
      (if (setq color (assoc 62 entlst))
        (setq opts (append opts (list (cons 62 (cdr color)))))
      )
      (setq opts (append opts (list(cons 10 cen) (cons 40 rad))))
      (if (entmake opts)
        (progn
          (entdel ent)
          (prompt (strcat "\nRadius bases on "
                    (nth rflag
                         '("endpoint of rectangle" "closest side"
                           "farthest side" "area of rectangle")
                     )
            )
          )
        )
        (prompt "\nError creating circle.")
      )
    )
    (prompt "\nError, object is not a closed rectangle.")
  )
  (princ)
)

[DEVITG]

Has anyone had any luck with this.  I just finished a foundation plan with spread footings under each column and the engineer walked by and said "you know those need to be on piers right?"  AAAARRRRGGGHHHH!!!!!!!!!  So...if anyone has something that converts a square to a circle I could really use it.  An example of how it would work is converting a 4'-0"X4'-0" square footing to a 4'-0" dia pier.

Any help is greatly appreciated

If talking about foundation , the circle shall be the same area, not the same diameter as side .

As a square 4' has a 16 sqr '  , a 4' diameter has 12.56 sq ' , so the load on terrain is higher for such circle , and all teh building could sunk on the terrain.

the diameter for a given circular area is

(setq diameter ( sqrt ( / area 0.785)))

0.785 = pi / 4
or

(setq diameter (sqrt ( / ( * side side ) ( / pi 4))))

[confusedCADguy]

I'm not worried about area.  Usually piers bear on rock which has a higher bearing pressure that soil so you can get by with less area but thats not the point.  This is just a preliminary drawing and I have close to a hundred footings to change.  I was just looking for something to change the squares (rectangles) to circles.  I can adjust the size of the circles later using qselect and properties manager.

[confusedCADguy]

THANKS CAB!!!!   Works perfectly!!!!!

 I owe you a beer or two for this one.

[t-bear]

The CABster done it ..... again!

[CAB]

DEVITG
Did not get your formula to work out but I added flag 3 for area matching option to the code above.

CAB

PS I got it devitg, thanks.

[CAB]

This version lets you choose the radius type.

Code: [Select]

(defun c:sq2circle ()
  ;;return: T if closed, nil otherwise
  (defun ispolyclosed (elist)
    (= 1 (logand 1 (cdr (assoc 70 (entget elist)))))
  )
  (defun get_vertex (elist)
    (mapcar 'cdr
    (vl-remove-if-not
      '(lambda (x) (= (car x) 10)) elist))
  )
  ;;  ==============  START  ==================
  (initget "Endpoint, Closest, Farthest, Area")
  (setq rflag
         (getkword
           "\nSelect radius type. [Endpoint, <Closest side>, Farthest side, Area]"))
  (if (null rflag)
    (setq rFlag 1)
    (setq rFlag (vl-position rFlag '("Endpoint" "Closest" "Farthest" "Area")))
  )
 
  (if (and (setq sq (entsel "\nSelect square to convert to a circle."))
           (= (cdr (assoc 0 (setq entlst (entget (setq ent (car sq))))))
              "LWPOLYLINE")
           (= (length (setq clst (get_vertex entlst))) 4)
           (ispolyclosed ent)
      )
    (progn
      ;;========================================================
      (cond
        ((= rflag 0);  Radius is endpoint of rectangle
         (setq rad (/ (distance (nth 0 clst) (nth 2 clst)) 2))
        )
        ((= rflag 1);  radius is closest side
         (setq rad (/ (min (distance (nth 0 clst) (nth 1 clst))
                           (distance (nth 1 clst) (nth 2 clst)))2))
        )
        ((= rflag 2);  radius is farthest side
         (setq rad (/ (max (distance (nth 0 clst) (nth 1 clst))
                           (distance (nth 1 clst) (nth 2 clst)))2))
        )
        ((= rflag 3);  match area of rectangle
         (setq rad (/(sqrt(/( * (distance (nth 0 clst) (nth 1 clst))
                                (distance (nth 1 clst) (nth 2 clst)))
                          (/ pi 4))) 2))
        )
      )
      ;;========================================================
      (setq cen (polar (nth 0 clst)
                       (angle (nth 0 clst) (nth 2 clst))
                       (/ (distance (nth 0 clst) (nth 2 clst)) 2))
      )
      (setq opts (list (cons 0 "CIRCLE")
                       (cons 8 (cdr (assoc 8 entlst))))
      )
      (if (setq lntyp (assoc 6 entlst))
        (setq opts (append opts (list (cons 6 (cdr lntyp)))))
      )
      (if (setq color (assoc 62 entlst))
        (setq opts (append opts (list (cons 62 (cdr color)))))
      )
      (setq opts (append opts (list(cons 10 cen) (cons 40 rad))))
      (if (entmake opts)
        (progn
          (entdel ent)
          (prompt (strcat "\n*-* Radius bases on "
                    (nth rflag
                         '("endpoints of rectangle" "closest side"
                           "farthest side" "area of rectangle")
                     ) " *-*"
            )
          )
        )
        (prompt "\nError creating circle.")
      )
    )
    (prompt "\nError, object is not a closed rectangle.")
  )
  (princ)
)

[DEVITG]

here is  a check routine

Code: [Select]

(setq side 2 )
(setq square-area ( expt side 2))
(prin1 (strcat (rtos square-area) "  is the square area for a side " (rtos side )" square"))
(setq diameter (sqrt ( / ( * side side ) ( / pi 4))))
(prin1 ( strcat (rtos diameter ) " is the diameter that give a circle with the same area  "))
(setq circ-area (* (expt diameter 2 ) ( / pi 4)))
(prin1 ( strcat (rtos circ-area) " is the area of the circle "))
(setq dif ( - circ-area square-area))
( prin1 (strcat ( rtos dif 2 20) "  is the area diference  "))