[编程交流] 快速断圆

(defun c:cBrk (/ *error* vl ov p1 ent p2 aDef flag ent)
 (vl-load-com)
 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov))
   (if (not
         (wcmatch
           (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " msg " >>")))
   (princ))
 (setq vl '("CMDECHO" "OSMODE")
       ov (mapcar 'getvar vl))
 (or (eq 512 (logand 512 (getvar 'OSMODE)))
     (setvar 'OSMODE (+ (getvar 'OSMODE) 512)))
 
 (while
   (progn
     (setq p1 (getpoint "\nSelect Point on Circle: "))
     (cond ((vl-consp p1)
            (if (and (setq ent (car (nentselp p1)))
                     (not (eq "CIRCLE" (cdr (assoc 0 (entget ent))))))
              (princ "\n** Point does not lie on a Circle **")))
           (t (princ "\n** No Point Selected  **")))))
 (while
   (progn
     (setq p2 (getpoint "\nSelect Second Point to Break: "))
     (cond ((vl-consp p2)
            (cond ((eq p1 p2)
                   (princ "\n** Points must be distinct **"))
                  (t (setq p2 (vlax-curve-getClosestPointto ent p2)) nil)))
           (t (princ "\n** No Point Selected **")))))
 (setq cen (cdr (assoc 10 (entget ent))))
 (repeat 2
   (setq aDef
     (list
       (cons 100 "AcDcEntity")
       (cons 0 "ARC")))
   (foreach dxf '(8 10 40 210)
     (setq aDef
       (cons
         (assoc dxf (entget ent)) aDef)))
   (setq aDef
     (append
       (reverse aDef)
         (list
           (cons 50
             (if flag
               (angle cen p1) (angle cen p2)))
           (cons 51
             (if flag
               (angle cen p2) (angle cen p1))))))
   (entmake aDef)
   (setq flag t))
 (entdel ent)
 (mapcar 'setvar vl ov)
 (princ))