;;; ---------------------------------------------------------------------------
;;; ArcCircle.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; CONVERTING BETWEEN ARCS, CIRCLES AND ELLIPSES
;;;
;;; PURPOSE
;;;   ARCTOCIRCLE  completes an arc into the full circle it is part of
;;;   CIRCLETOARC  the other way, cutting a circle back to an arc between two
;;;                points picked on it
;;;   CIRCLETOELLIPSE  turns a circle into an ellipse of the same size, ready
;;;                    to be squashed one way
;;;
;;;   All three keep the layer, colour, linetype, lineweight and thickness of
;;;   what they replace. That is the point of them - drawing a new one by hand
;;;   means setting all of that again.
;;;
;;; WHAT WAS FIXED
;;;   The arc-to-circle routine rebuilt the object by copying its DXF data and
;;;   dropping the start and end angles. That copies group -1 and group 5 as
;;;   well - the entity name and the handle - and ENTMAKE will not accept
;;;   either. The properties worth keeping are now copied by name.
;;;
;;;   The circle-to-ellipse routine had four separate faults:
;;;     - It guarded against picking something already converted by testing for
;;;       a POLYLINE, which is what an ellipse was before Release 14. On any
;;;       modern AutoCAD an ellipse is its own object type, so the guard never
;;;       fired. Worse, a LINE sailed through it and was then read as a circle,
;;;       producing an ellipse from whatever numbers happened to be in the data.
;;;     - It read the colour with (assoc 62 ...), which is ABSENT on a BYLAYER
;;;       object - the usual case - so the colour came back nil and was handed
;;;       straight to CHPROP, which stopped with a bad argument.
;;;     - It took three commands to do the job: ELLIPSE, then CHPROP to put the
;;;       properties back, then ERASE. One ENTMAKE does all of it.
;;;     - Its opening loop compared against the quoted symbol 'nil.
;;;
;;;   Neither had an error handler or an undo group.
;;;
;;;   ARCTOCIRCLE      - close an arc into a circle
;;;   CIRCLETOARC      - cut a circle back to an arc
;;;   CIRCLETOELLIPSE  - turn a circle into an ellipse
;;; ---------------------------------------------------------------------------

;;; ---------------------------------------------------------------------------
;;; PROPERTIES
;;;
;;; Copied by name, not by taking the whole data list. Groups absent from the
;;; original are absent from the copy, which is how BYLAYER stays BYLAYER.
;;; ---------------------------------------------------------------------------

(defun ArcCirc:Props ( data / out )
    (foreach code '(8 6 62 370 39 48 210)
        (if (assoc code data) (setq out (cons (assoc code data) out))))
    (reverse out)
)

(defun ArcCirc:Pick ( prompt want / sel ent kind )
    (setq ent nil)
    (while (and (null ent)
                (setq sel (entsel (strcat "\n" prompt " <Enter to finish>: "))))
        (setq kind (cdr (assoc 0 (entget (car sel)))))
        (if (= kind want)
            (setq ent (car sel))
            (princ (strcat "\n  That is a " kind ", not a"
                           (if (member (substr want 1 1) '("A" "E")) "n " " ")
                           (strcase want t) "."))))
    ent
)

;;; ---------------------------------------------------------------------------
;;; ARC TO CIRCLE
;;; ---------------------------------------------------------------------------

(defun c:ARCTOCIRCLE ( / *error* vars vals ss i ent data n )

    (setq vars '("CMDECHO") vals (mapcar 'getvar vars))

    (defun ArcCirc:Restore ( )
        (mapcar 'setvar vars vals)
        (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End"))
        (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
        (princ)
    )

    (defun *error* ( msg )
        (ArcCirc:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** ARCTOCIRCLE error: " msg " **")))
        (princ)
    )

    (setvar "CMDECHO" 0)
    ;; AutoCAD 2015 and later refuse (command) inside an *error* handler unless
    ;; the routine says up front that it will use one.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")

    (princ "\nSelect the arcs to close into circles.")
    (setq ss (ssget '((0 . "ARC"))) i 0 n 0)

    (if (null ss)
        (princ "\nNo arcs selected.")
        (progn
            (while (< i (sslength ss))
                (setq ent  (ssname ss i)
                      data (entget ent))
                (if (entmake (append
                        (list '(0 . "CIRCLE")
                              (assoc 10 data)
                              (assoc 40 data))
                        (ArcCirc:Props data)))
                    (progn (entdel ent) (setq n (1+ n))))
                (setq i (1+ i)))
            (princ (strcat "\n" (itoa n) " arc" (if (= n 1) "" "s")
                           " closed into circle" (if (= n 1) "" "s") "."))))

    (ArcCirc:Restore)
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; CIRCLE TO ARC
;;; ---------------------------------------------------------------------------

(defun c:CIRCLETOARC ( / *error* vars vals ent data cen rad p1 p2 a1 a2 n )

    (setq vars '("CMDECHO" "OSMODE") vals (mapcar 'getvar vars))

    (defun ArcCirc:Restore ( )
        (mapcar 'setvar vars vals)
        (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End"))
        (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
        (princ)
    )

    (defun *error* ( msg )
        (ArcCirc:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** CIRCLETOARC error: " msg " **")))
        (princ)
    )

    (setvar "CMDECHO" 0)
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")

    (setq n 0)
    (while (setq ent (ArcCirc:Pick "Circle to cut back" "CIRCLE"))
        (setq data (entget ent)
              cen  (cdr (assoc 10 data))
              rad  (cdr (assoc 40 data)))

        ;; The two points are only used for their direction from the centre, so
        ;; they need not be exactly on the circle - picking roughly where the
        ;; arc should start and stop is enough.
        (setvar "OSMODE" 0)
        (if (and (setq p1 (getpoint cen "\n  Start of the arc, going anticlockwise: "))
                 (setq p2 (getpoint cen "\n  End of the arc: ")))
            (progn
                (setq a1 (angle cen p1)
                      a2 (angle cen p2))
                (if (entmake (append
                        (list '(0 . "ARC") (cons 10 cen) (cons 40 rad)
                              (cons 50 a1) (cons 51 a2))
                        (ArcCirc:Props data)))
                    (progn (entdel ent) (setq n (1+ n)))))))

    (princ (strcat "\n" (itoa n) " circle" (if (= n 1) "" "s") " cut back."))

    (ArcCirc:Restore)
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; CIRCLE TO ELLIPSE
;;;
;;; An ELLIPSE stores its centre in group 10, the vector from the centre to one
;;; end of the major axis in group 11, and the ratio of minor to major in group
;;; 40. A circle is the case where that ratio is 1.
;;; ---------------------------------------------------------------------------

(defun c:CIRCLETOELLIPSE ( / *error* vars vals ent data cen rad n ratio v )

    (setq vars '("CMDECHO") vals (mapcar 'getvar vars))

    (defun ArcCirc:Restore ( )
        (mapcar 'setvar vars vals)
        (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End"))
        (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
        (princ)
    )

    (defun *error* ( msg )
        (ArcCirc:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** CIRCLETOELLIPSE error: " msg " **")))
        (princ)
    )

    (setvar "CMDECHO" 0)
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")

    (initget 6)
    (setq ratio (getreal "\nMinor axis as a fraction of the major <1.0>: "))
    (if (or (null ratio) (> ratio 1.0)) (setq ratio 1.0))

    (princ "\nSelect the circles to convert.")
    (setq v (ssget '((0 . "CIRCLE"))) n 0)

    (if (null v)
        (princ "\nNo circles selected.")
        (progn
            (setq ent 0)
            (while (< ent (sslength v))
                (setq data (entget (ssname v ent))
                      cen  (cdr (assoc 10 data))
                      rad  (cdr (assoc 40 data)))
                (if (entmake (append
                        (list '(0 . "ELLIPSE") '(100 . "AcDbEntity")
                              '(100 . "AcDbEllipse")
                              (cons 10 cen)
                              ;; Major axis vector, laid along X.
                              (cons 11 (list rad 0.0 0.0))
                              (cons 40 ratio)
                              '(41 . 0.0) (cons 42 (* 2.0 pi)))
                        (ArcCirc:Props data)))
                    (progn (entdel (ssname v ent)) (setq n (1+ n))))
                (setq ent (1+ ent)))
            (princ (strcat "\n" (itoa n) " circle" (if (= n 1) "" "s")
                           " turned into ellipse" (if (= n 1) "" "s")
                           (if (equal ratio 1.0 1e-9)
                               " - still round, ready to be squashed."
                               (strcat " at a ratio of " (rtos ratio 2 3) "."))))))

    (ArcCirc:Restore)
    (princ)
)

(princ)