[编程交流] 如何修剪圆弧与圆弧之间的直线

(defun c:TEst (/ _dist obj compare base point temp line)
 ;; http://www.cadtutor.net/forum/showthread.php?56505-How-to-trim-line-between-arc-or-semicircle
 ;; Alan J. Thompson, 02.02.11
 (vl-load-com)
 (defun _dist (a b) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))
 (if (and (setq compare (cadr (AT:GetSel entsel
                                         "\nSelect arc for copying (basepoint is closest end point): "
                                         (lambda (x)
                                           (if (eq "ARC" (cdr (assoc 0 (entget (car x)))))
                                             (setq obj (vlax-ename->vla-object (car x)))
                                           )
                                         )
                              )
                        )
          )
          (setq base
                 (car (vl-sort
                        (list (vlax-curve-getStartPoint obj) (vlax-curve-getEndPoint obj))
                        (function
                          (lambda (a b) (< (_dist a (trans compare 1 0)) (_dist b (trans compare 1 0))))
                        )
                      )
                 )
          )
     )
   (while (setq point (acet-ss-drag-move
                        (ssadd (vlax-vla-object->ename obj))
                        (trans base 0 1)
                        "\nSpecify placement point on line: "
                        T
                      )
          )
     (if (vl-catch-all-error-p
           (setq line (vl-catch-all-apply
                        (function (lambda (/)
                                    (ssname (ssget point '((0 . "LINE,*POLYLINE"))) 0)
                                  )
                        )
                      )
           )
         )
       (princ "\nPoint must be on Line or Polyline!")
       (progn (vla-move (setq temp (vla-copy obj))
                        (vlax-3d-point base)
                        (vlax-3d-point (trans point 1 0))
              )
              (vl-cmdf "_.break"
                       line
                       "_F"
                       "_non"
                       (trans (vlax-curve-getStartPoint temp) 0 1)
                       "_non"
                       (trans (vlax-curve-getEndPoint temp) 0 1)
              )
       )
     )
   )
 )
 (princ)
)
(defun AT:GetSel (meth msg fnc / ent good)
 ;; meth - selection method (entsel, nentsel, nentselp)
 ;; msg - message to display (nil for default)
 ;; fnc - optional function to apply to selected object
 ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
 ;; Alan J. Thompson, 05.25.10
 (setvar 'errno 0)
 (while (not good)
   (setq ent (meth (cond (msg)
                         ("\nSelect object: ")
                   )
             )
   )
   (cond
     ((vl-consp ent)
      (setq good (cond ((or (not fnc) (fnc ent)) ent)
                       ((prompt "\nInvalid object!"))
                 )
      )
     )
     ((eq (type ent) 'STR) (setq good ent))
     ((setq good (eq 52 (getvar 'errno))) nil)
     ((eq 7 (getvar 'errno)) (setq good (prompt "\nMissed, try again.")))
   )
 )
)