;;; ---------------------------------------------------------------------------
;;; RoundMask.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Creates CIRCULAR wipeouts, which AutoCAD cannot do natively.
;;;
;;; The built-in WIPEOUT command only accepts a polygonal boundary, so masking
;;; a circular area - a column, a manhole, a bolt hole on a detail - normally
;;; means drawing a many-sided polygon by hand and hoping it looks round.
;;;
;;; COMMANDS
;;;   ROUNDMASK  - draw a circular wipeout from a centre and radius
;;;   CIRC2MASK  - convert existing circles into wipeouts of the same size and
;;;                properties, deleting the original circles
;;;
;;; HOW A ROUND WIPEOUT IS FAKED
;;; A wipeout is really an image entity with a clipping boundary. The boundary
;;; is stored as a list of DXF group 14 points expressed in NORMALISED image
;;; space, where the image occupies a unit square running from -0.5 to +0.5 in
;;; both directions. Points at radius 0.5 from the centre of that square
;;; therefore trace a circle that exactly fills the image.
;;;
;;; So the circle is built once, in normalised space, at a fixed resolution -
;;; and the actual size and position come from the image's own U and V vectors
;;; (groups 11 and 12), which are set to the required diameter. This is why the
;;; result stays perfectly circular at any scale.
;;;
;;; Both commands work correctly in any UCS and any view.
;;; ---------------------------------------------------------------------------

;; ---------------------------------------------------------------------------
;; Number of segments used to approximate the circular boundary. Fifty is a
;; good balance: visually smooth at normal zoom while keeping the entity small.
;; Raise it if masks are being viewed at extreme magnification.
;; ---------------------------------------------------------------------------
(setq RoundMask:Segments 50)

;; ---------------------------------------------------------------------------
;; RoundMask:LoadArx
;; ---------------------------------------------------------------------------
;; Ensures the wipeout ARX modules are loaded, returning T on success.
;;
;; Wipeout support lives in an ARX module that is demand-loaded, so in a fresh
;; session it may not be present and entmakex would silently fail to produce a
;; usable object. The module was renamed across AutoCAD versions, so both names
;; are tried; the nil second argument to arxload suppresses the error dialog if
;; a given name is not available on this release.
;; ---------------------------------------------------------------------------
(defun RoundMask:LoadArx ( )
    (or (member "acwipeout.arx" (arx))
        (member "acismui.arx"   (arx))
        (arxload "acwipeout.arx" nil)
        (arxload "acismui.arx"   nil)
    )
)

;; ---------------------------------------------------------------------------
;; RoundMask:Create
;; ---------------------------------------------------------------------------
;; Builds one circular wipeout and returns its entity name.
;;
;; The construction, group by group:
;;
;;   10  insertion point - the BOTTOM-LEFT corner of the bounding square, not
;;       the centre, which is why the radius is subtracted from both ordinates
;;   11  U vector - the image's horizontal axis, set to the full diameter
;;   12  V vector - the image's vertical axis, likewise
;;   280 display flag, 1 = visible
;;   71  boundary type, 2 = polygonal clip
;;   14  the clip boundary points, in normalised -0.5 to +0.5 image space
;;
;; The final (cons (last lst) lst) repeats the last point at the front of the
;; list, closing the boundary - an unclosed clip boundary produces a wipeout
;; with a visible notch in it.
;;
;; cen - [list] centre point, in the current UCS
;; rad - [real] radius
;; ---------------------------------------------------------------------------
(defun RoundMask:Create ( cen rad / ang inc lst )

    ;; inc was a leaked global in the original - it was assigned without being
    ;; declared local, so it silently overwrote any variable of the same name
    ;; elsewhere in the session. All three are properly localised here.
    (setq inc (/ (* 2.0 pi) RoundMask:Segments)
          ang 0.0
          lst nil
    )

    ;; Trace the unit circle at radius 0.5 in normalised image space.
    (repeat RoundMask:Segments
        (setq lst (cons (list 14 (* 0.5 (cos ang)) (* 0.5 (sin ang))) lst)
              ang (+ ang inc)
        )
    )

    (entmakex
        (append
            (list
               '(000 . "WIPEOUT")
               '(100 . "AcDbEntity")
               '(100 . "AcDbWipeout")
                ;; Bottom-left of the bounding square, converted to WCS.
                (cons 10 (trans (mapcar '- cen (list rad rad)) 1 0))
                ;; U and V axes. The trailing t makes these displacement
                ;; vectors rather than points, so they are rotated by the UCS
                ;; but not translated by its origin.
                (cons 11 (trans (list (+ rad rad) 0.0) 1 0 t))
                (cons 12 (trans (list 0.0 (+ rad rad)) 1 0 t))
               '(280 . 1)
               '(071 . 2)
            )
            (cons (last lst) lst)
        )
    )
)

;; ---------------------------------------------------------------------------
;; RoundMask:DefaultProps
;; ---------------------------------------------------------------------------
;; Returns a full set of common property groups for the supplied entity data,
;; filling in AutoCAD's defaults for any group the entity does not carry.
;;
;; This is needed when copying properties from a circle onto a wipeout. An
;; object sitting on layer 0 with BYLAYER colour simply has no group 8 or 62 in
;; its data - the absence IS the default. Without substituting the defaults
;; back in, those properties would be left at whatever the new wipeout happened
;; to inherit rather than matching the circle it replaced.
;; ---------------------------------------------------------------------------
(defun RoundMask:DefaultProps ( elist )
    (mapcar
        (function
            (lambda ( pair )
                (cond ((assoc (car pair) elist)) ( pair ))
            )
        )
       '(
            (008 . "0")         ; layer
            (006 . "BYLAYER")   ; linetype
            (039 . 0.0)         ; thickness
            (062 . 256)         ; colour, 256 = BYLAYER
            (048 . 1.0)         ; linetype scale
            (370 . -1)          ; lineweight, -1 = BYLAYER
        )
    )
)

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

;; ---------------------------------------------------------------------------
;; c:ROUNDMASK  -  draw a circular wipeout
;; ---------------------------------------------------------------------------
(defun c:ROUNDMASK ( / *error* vars vals cen rad )

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

    (defun *error* ( msg )
        (RoundMask:Restore vars vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** ROUNDMASK 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. Restore does,
    ;; to close this undo group. The declaring call is absent on older
    ;; releases, so it is wrapped rather than tested for.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")

    (cond
        (   (not (RoundMask:LoadArx))
            (princ "\nWipeout support could not be loaded on this AutoCAD version.")
        )
        (   (and (setq cen (getpoint "\nSpecify centre of mask: "))
                 ;; getdist rubber-bands from the centre, so the radius can be
                 ;; picked visually as well as typed.
                 (setq rad (getdist cen "\nSpecify radius: "))
            )
            (if (RoundMask:Create cen rad)
                (princ "\nCircular wipeout created.")
                (princ "\nThe wipeout could not be created.")
            )
        )
        (   t
            (princ "\n*Cancelled*")
        )
    )

    (RoundMask:Restore vars vals)
    (princ)
)

;; ---------------------------------------------------------------------------
;; c:CIRC2MASK  -  convert existing circles into wipeouts
;; ---------------------------------------------------------------------------
(defun c:CIRC2MASK ( / *error* vars vals sel idx ent enx wip count )

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

    (defun *error* ( msg )
        (RoundMask:Restore vars vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** CIRC2MASK 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. Restore does,
    ;; to close this undo group. The declaring call is absent on older
    ;; releases, so it is wrapped rather than tested for.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")

    (cond
        (   (not (RoundMask:LoadArx))
            (princ "\nWipeout support could not be loaded on this AutoCAD version.")
        )

        ;; "_:L" excludes objects on locked layers, which could not be deleted
        ;; afterwards anyway - better to refuse them at selection than to
        ;; create a wipeout and then fail to remove the circle beneath it.
        (   (setq sel (ssget "_:L" '((0 . "CIRCLE"))))
            (setq count 0)
            (repeat (setq idx (sslength sel))
                (setq ent (ssname sel (setq idx (1- idx)))
                      enx (entget ent)
                      ;; The centre is transformed from the circle's own
                      ;; coordinate system into the current UCS, so circles
                      ;; drawn in a rotated UCS convert to the right place.
                      wip (RoundMask:Create
                              (trans (cdr (assoc 10 enx)) ent 1)
                              (cdr (assoc 40 enx))
                          )
                )
                ;; Only remove the circle once its replacement exists - if
                ;; creation failed, the drawing is left exactly as it was.
                (if wip
                    (progn
                        (entmod (cons (cons -1 wip) (RoundMask:DefaultProps enx)))
                        (entdel ent)
                        (setq count (1+ count))
                    )
                )
            )
            (princ (strcat "\n" (itoa count) " of " (itoa (sslength sel))
                           " circle" (if (= 1 (sslength sel)) "" "s")
                           " converted to wipeouts."
                   )
            )
        )

        (   t
            (princ "\nNo circles selected.")
        )
    )

    (RoundMask:Restore vars vals)
    (princ)
)

(princ)