[编程交流] 我需要一个Lisp程序的语言来改变关闭

(defun c:Test (/ ss i sn pt r spc vl)
 (vl-load-com)
;;; Tharwat 25 . June . 2012 ;;;
 (if (not acdoc)
   (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
 )
 (setq spc (if (> (vla-get-activespace acdoc) 0)
             (vla-get-modelspace acdoc)
             (vla-get-paperspace acdoc)
           )
 )
 (if (setq ss (ssget "_:L" '((0 . "*POLYLINE"))))
   (progn
     (repeat (setq i (sslength ss))
       (setq sn (ssname ss (setq i (1- i))))
       (if (vlax-curve-isclosed (setq vl (vlax-ename->vla-object sn)))
         (progn
           (entmakex
             (list
               '(0 . "CIRCLE")
               (cons 10
                     (vlax-safearray->list
                       (vlax-variant-value
                         (vla-get-Centroid
                           (setq r
                                  (car (vlax-invoke spc 'addregion (list vl)))
                           )
                         )
                       )
                     )
               )
               '(40 . 2.0)
             )
           )
           (entdel (cdr (assoc -1 (entget sn))))
           (vla-delete r)
         )
       )
     )
   )
 )
 (princ)
)

([color=BLUE]defun[/color] c:p2c ( [color=BLUE]/[/color] _vertices _vertices1 _vertices2 _pointaverage e i r s )
   ([color=BLUE]setq[/color] r 0.1) [color=GREEN];; Circle Radius[/color]
   ([color=BLUE]defun[/color] _vertices ( l )
       ([color=BLUE]if[/color] ([color=BLUE]eq[/color] [color=MAROON]"LWPOLYLINE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 l)))
           (_vertices1 l)
           (_vertices2 ([color=BLUE]entnext[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] -1 l))))
       )
   )
   
   ([color=BLUE]defun[/color] _vertices1 ( l [color=BLUE]/[/color] p )
       ([color=BLUE]if[/color] ([color=BLUE]setq[/color] p ([color=BLUE]assoc[/color] 10 l))
           ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] p) (_vertices1 ([color=BLUE]cdr[/color] ([color=BLUE]member[/color] p l))))
       )
   )
   ([color=BLUE]defun[/color] _vertices2 ( e )
       ([color=BLUE]if[/color] ([color=BLUE]eq[/color] [color=MAROON]"VERTEX"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] e))))
           ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 ([color=BLUE]entget[/color] e))) (_vertices2 ([color=BLUE]entnext[/color] e)))
       )
   )
   
   ([color=BLUE]defun[/color] _pointaverage ( l [color=BLUE]/[/color] x )
       ([color=BLUE]setq[/color] x ([color=BLUE]length[/color] l)) 
       ([color=BLUE]mapcar[/color] '[color=BLUE]/[/color] ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] '[color=BLUE]+[/color] l)) ([color=BLUE]list[/color] x x))
   )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] s ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color] '((0 . [color=MAROON]"*POLYLINE"[/color]))))
       ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
           ([color=BLUE]setq[/color] e ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] s ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i)))))
           ([color=BLUE]if[/color] ([color=BLUE]entmake[/color]
                   ([color=BLUE]list[/color]
                      '(0 . [color=MAROON]"CIRCLE"[/color])
                       ([color=BLUE]assoc[/color] 008 e)
                       ([color=BLUE]cons[/color]  010 (_pointaverage (_vertices e)))
                       ([color=BLUE]cons[/color]  040 r)
                       ([color=BLUE]cond[/color] (([color=BLUE]assoc[/color] 006 e)) ('(006 . [color=MAROON]"BYLAYER"[/color])))
                       ([color=BLUE]cond[/color] (([color=BLUE]assoc[/color] 039 e)) ('(039 . 0.0)))
                       ([color=BLUE]cond[/color] (([color=BLUE]assoc[/color] 062 e)) ('(062 . 256)))
                       ([color=BLUE]cond[/color] (([color=BLUE]assoc[/color] 370 e)) ('(370 . -1)))
                       ([color=BLUE]assoc[/color] 210 e)
                       ([color=BLUE]assoc[/color] 410 e)
                   )
               )
               ([color=BLUE]entdel[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] -1 e)))
           )
       )
   )
   ([color=BLUE]princ[/color])
)

(defun c:p2c ( / _vertices _vertices1 _vertices2 _uniquefuzz _pointaverage e i r s )
   (setq r 0.1) ;; Circle Radius
   (defun _vertices ( l )
       (if (eq "LWPOLYLINE" (cdr (assoc 0 l)))
           (_vertices1 l)
           (_vertices2 (entnext (cdr (assoc -1 l))))
       )
   )
   
   (defun _vertices1 ( l / p )
       (if (setq p (assoc 10 l))
           (cons (cdr p) (_vertices1 (cdr (member p l))))
       )
   )
   (defun _vertices2 ( e )
       (if (eq "VERTEX" (cdr (assoc 0 (entget e))))
           (cons (cdr (assoc 10 (entget e))) (_vertices2 (entnext e)))
       )
   )
   (defun _uniquefuzz ( l f )
       (if l
           (cons (car l)
               (_uniquefuzz
                   (vl-remove-if '(lambda ( x ) (equal x (car l) f)) (cdr l))
                   f
               )
           )
       )
   )
   
   (defun _pointaverage ( l / x )
       (setq x (length l)) 
       (mapcar '/ (apply 'mapcar (cons '+ l)) (list x x))
   )
   (if (setq s (ssget "_:L" '((0 . "*POLYLINE"))))
       (repeat (setq i (sslength s))
           (setq e (entget (ssname s (setq i (1- i)))))
           (if (entmake
                   (list
                      '(0 . "CIRCLE")
                       (assoc 008 e)
                       (cons  010 (_pointaverage (_uniquefuzz (_vertices e) 1e-))
                       (cons  040 r)
                       (cond ((assoc 006 e)) ('(006 . "BYLAYER")))
                       (cond ((assoc 039 e)) ('(039 . 0.0)))
                       (cond ((assoc 062 e)) ('(062 . 256)))
                       (cond ((assoc 370 e)) ('(370 . -1)))
                       (assoc 210 e)
                       (assoc 410 e)
                   )
               )
               (entdel (cdr (assoc -1 e)))
           )
       )
   )
   (princ)
)