[综合讨论] 如何延长弧？

;; Quick Arc Editor, by Lee McDonnell  20.07.2009
(defun c:acEd (/ *error* foo prop str ent Obj
                eLst gr dat val osPt)
 (vl-load-com)
 (defun *error* (err)
   (if (and Obj eLst (not (vlax-erased-p Obj)))
     (mapcar
       (function
         (lambda (x)
           (vlax-put-property Obj (car x) (cdr x)))) eLst))
   (if (not
         (wcmatch
           (strcase err) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n** Error: " err " **"))
     (princ "\n*Cancel*"))
   (redraw) (princ))
 (setq foo 'distance prop 'Radius str "")
 
 (while
   (progn
     (setq ent (entsel "\nSelect Arc/Circle: "))
     (cond ((vl-consp ent)
            (if (vl-position
                  (vla-get-ObjectName
                    (setq Obj
                      (vlax-ename->vla-object (car ent))))
              '("AcDbArc" "AcDbCircle")) nil
            (princ "\n** Invalid Object Selection **")))
           (t (princ "\n** Nothing Selected **")))))
 (foreach x '(StartAngle EndAngle Radius)
   (and (vlax-property-available-p Obj x)
        (setq eLst
          (cons
            (cons x (vlax-get-property Obj x)) eLst))))
             
   (while
     (progn
       (setq gr (grread 't 15 0) dat (cadr gr)) (redraw)
       (cond ((and (eq 5 (car gr)) (listp (setq cPt (cadr gr))))
              (if (and (< 0 (getvar "OSMODE") 16383)
                 (setq osPt (osnap dat (osLst (getvar "OSMODE")))))
                 (osMark osPt))
              (vlax-put-property Obj prop
                ((eval foo) (vlax-get Obj 'Center) cPt))
              (grdraw (vlax-get Obj 'Center) cPt 30 (~ -2)) t)
             ((eq 25 (car gr)) nil)
             ((eq 3 (car gr))
              (if (and (< 0 (getvar "OSMODE") 16383)
                 (setq osPt (osnap dat (osLst (getvar "OSMODE")))))
                (vlax-put-property Obj prop
                  ((eval foo) (vlax-get Obj 'Center) osPt))))
             ((eq 2 (car gr))
              (cond ((or (< 47 dat 58) (eq dat 46))
                     (princ (chr dat))
                     (setq str (strcat str (chr dat))))
                    ((and (= dat  (> (strlen str) 0))
                     (princ (strcat (chr  " " (chr ))
                     (setq str (substr str 1 (1- (strlen str)))))
                    ((eq 6 dat)
                     (cond ((< 0 (getvar "OSMODE") 16384)
                            (setvar "OSMODE" (+ 16384 (getvar "OSMODE"))))
                           (t (setvar "OSMODE" (- (getvar "OSMODE") 16384)))))
                    ((eq 9 dat)
                     (and (eq "AcDbArc" (vla-get-ObjectName Obj))
                          (setq foo  (cond ((eq foo 'angle) 'distance) (t 'angle))))
                     (setq prop (cond ((vl-position prop '(EndAngle StartAngle))
                                       (setq prop 'Radius))
                                      (t (setq prop (propt Obj cPt))))))                      
                    ((vl-position dat '(13 32))
                     (cond ((or (and (eq foo 'angle) (setq val (angtof str 0)))
                                (and (eq foo 'distance) (setq val (distof str))))
                            (vlax-put-property Obj prop val)))) '(t)))
             (t)))) (redraw)
 (princ))
(defun propt (Obj pt)
 (if (eq "AcDbArc" (vla-get-ObjectName Obj))
   (cond ((> (distance pt (vlax-get Obj 'StartPoint))
             (distance pt (vlax-get Obj 'EndPoint))) 'EndAngle)
         (t 'StartAngle)) 'Radius))
(defun oSlst (os / str cnt)
 (setq str "" cnt 0)
 (if (< 0 os 16383)
   (foreach mod '("_end" "_mid" "_cen" "_nod" "_qua"
                  "_int" "_ins" "_per" "_tan" "_nea"
                  "_non" "_app" "_ext" "_par")
     (if (not (zerop (logand (expt 2 cnt) os)))
       (setq str (strcat str mod (chr 44))))
     (setq cnt (1+ cnt))))
 (vl-string-right-trim (chr 44) str))
(defun osMark (pt / drft osSz osCol ratio bold glst i)
 (setq drft (vla-get-drafting
              (vla-get-preferences
                (vlax-get-acad-object)))
       osSz (vla-get-AutoSnapMarkerSize drft)
       oscol (vla-get-AutoSnapMarkerColor drft)
       ratio (/ (getvar "VIEWSIZE")
              (cadr (getvar "SCREENSIZE")))
       bold (mapcar
              (function
                (lambda (x)
                  (* x ratio))) (list (+ osSz 0.5) osSz (- osSz 0.5))) i 0)
 (repeat 50
   (setq glst
     (cons
       (polar '(0 0 0) (* i (/ pi 25.)) 1.) glst) i (1+ i)))      
 (foreach x bold
    (grvecs (append (list oscol) glst (cdr glst) (list (car glst)))
            (list (list  x  0.0 0.0 (car pt))
                  (list 0.0  x  0.0 (cadr pt))
                  (list 0.0 0.0 1.0 0.0)
                  (list 0.0 0.0 0.0 1.0)))))
                     (princ (strcat (chr  " " (chr ))
                     (setq str (substr str 1 (1- (strlen str)))))
                    ((eq 9 dat)
                     (and (eq "AcDbArc" (vla-get-ObjectName Obj))
                          (setq foo  (cond ((eq foo 'angle) 'distance) (t 'angle))))
                     (setq prop (cond ((vl-position prop '(EndAngle StartAngle))
                                       (setq prop 'Radius))
                                      (t (setq prop (propt Obj cPt))))))                      
                    ((vl-position dat '(13 32))
                     (cond ((or (and (eq foo 'angle) (setq val (angtof str 0)))
                                (and (eq foo 'distance) (setq val (distof str))))
                            (vlax-put-property Obj prop val)))) '(t)))
             (t)))) (redraw)
 (princ))
(defun propt (Obj pt)
 (if (eq "AcDbArc" (vla-get-ObjectName Obj))
   (cond ((> (distance pt (vlax-get Obj 'StartPoint))
             (distance pt (vlax-get Obj 'EndPoint))) 'EndAngle)
         (t 'StartAngle)) 'Radius))