一个程序，请各位高手看一看

hpy

下面这个程序是一本书上的。它的功能是给圆添加中心线并使中心线随着圆的改变而改变。
在使用中觉得程序有一点点问题。具体表现在如果对圆进行了编辑（比如拉伸、移动等）后
如果进行"undo"操作，在AutoCAD2002中会出现提示：错误：Automation错误，未提供说明。
如果再对圆进行编辑则中心线不再随着圆的改变而改变。在AutoCAD2004中不会出现错误提示，
但如果再对圆进行编辑则中心线也不再随着圆的改变而改变。
    请各位高手看一看，帮忙解决一下这个问题。另外该程序一次只能对一个圆添加中心线，如果
能对多个圆添加中心线那就更好了。


(defun c:ccen ()
    (setvar "CMDECHO" 0)
    (vl-load-com) ;;加载visualisp延伸功能
    (setq acadobject (vlax-get-acad-object))
    (setq acadDocument (vla-get-ActiveDocument acadobject))
    (setq mspace (vla-get-ModelSpace acadDocument))
    (setq util (vla-get-Utility acadDocument))
    (setq lts (vla-get-Linetypes acadDocument))
    ;;获取模型空间变量，utility变量与线型变量
    (setq selsets (vla-get-Selectionsets acadDocument)) ;;获取当前图形中的选择集
    (setq i (vla-get-Count selsets)) ;;将选到的变量存在变量i中
    (while (> i 0)
        (setq sset (vla-item selsets 0))
        (vla-delete sset)
        (setq i (- i 1))
    )  ;;;这个程序是说:如果选择集中有图元存在，则将其从选择集中删除，
       ;;;注意:这并不会从图面上真正删除图元。
    (setq sset (vla-add selsets "sset"))
    ;;新建选择集sset，如果没有以上的准备工作，则在下一次执行程序时，由于
    ;;sset选择集已存在，执行到此就无法新建一个同名选择集，程序会提示一
    ;;错误信息
    (vla-SelectOnScreen sset)
    (setq notallcircle nil) ;;设定变量notallcircle来判断是或所选对象为圆
    (setq ssetcount (vla-get-count sset)) ;;获取选择集中图元数量
    (while (> ssetcount 0)
        (setq obj (vla-item sset (- ssetcount 1)))
        (setq objname (vla-get-objectname obj))
        (if (/= objname "AcDbCircle")
            (setq notallcircle t)
        )
       (setq ssetcount (- ssetcount 1))
     ) ;;上面的循环程序用来判断是或所选图元均为圆(用图元名判断)若非，设定变量notallcircle为t
     (while (and (vla-get-count sset) notallcircle)
         (prompt "所选图元中至少有一非圆的图元，请再选一次，或按ESC结束!")
         (vla-clear sset)
         (vla-SelectOnScreen sset)
         (setq notallcircle nil)
         (setq ssetcount (vla-get-count sset))
     (while (> ssetcount 0)
         (setq obj (vla-item sset (- ssetcount 1)))
         (setq objname (vla-get-objectname obj))
         (if (/= objname "AcDbCircle")
             (setq notallcircle t)
         )
        (setq ssetcount (- ssetcount 1))
      ))
      (setq circ-d (vla-get-Radius obj))
      (setq circ-cen (vla-get-center obj))
      (setq pt (vla-PolarPoint util circ-cen 0 (+ 5 circ-d)))
      (setq line (vla-addline mspace circ-cen pt))
      (load-line-types "CENTER" "acad.lin")
      (vla-put-Linetype line "CENTER")
      (setq lts (/ circ-d 5))
      (vla-put-LinetypeScale line lts)
      (setq linearray (vla-ArrayPolar line 4 (/ (* pi 2 (1- 4)) 4) circ-cen))
      (vla-delete sset)
      (setq circleReactor (VLR-Object-Reactor (list obj) "circle Reactor"
           '((:VLR-modified . mark))))
)
(defun load-line-types (line-type file-name / tmp res)
     (if (and (setq tmp (vlax-get-acad-object))
         (setq tmp (vla-get-activedocument tmp))
         (setq tmp (vla-get-linetypes tmp))
     )
     (if (setq res (find-line-type line-type tmp))
         res
         (progn (vla-load tmp line-type file-name)
            (if (vla-item tmp line-type)
                (vla-item tmp line-type) nil)
            )
          ) nil
      )
)
(defun find-line-type (line-type line-type-collection / res)
    (setq line-type (strcase line-type))
    (vlax-for 1-obj line-type-collection (if (= (strcase
              (vla-get-name 1-obj)) line-type)
              (setq res 1-obj)
     )) res
)
(defun mark (notifier-object reactor-object parameter-list)
    (vl-load-com)
    (setq circ-d (vla-get-Radius obj))
    (setq circ-cen (vla-get-center obj))
    (setq pt (vla-PolarPoint util circ-cen 0 (+ 5 circ-d)))
    (vla-delete line)
    (setq linesafearray (vlax-variant-value linearray))
    (vla-delete (vlax-safearray-get-element linesafearray 0))
    (vla-delete (vlax-safearray-get-element linesafearray 1))
    (vla-delete (vlax-safearray-get-element linesafearray 2))
    (setq line (vla-addline mspace circ-cen pt))
    (load-line-types "CENTER" "acad.lin")
    (vla-put-Linetype line "CENTER")
    (setq lts (/ circ-d 5))
    (vla-put-LinetypeScale line lts)
    (setq linearray (vla-ArrayPolar line 4 (/ (* pi 2 (1- 4)) 4) circ-cen))
)

meflying

这个程序存在很大的问题，就是在回调函数全部使用的全局变量，这样的程序没有太大的用处，因为稍有变化，它就会发生错误。

当然，你说的这种错误在一般的反应器中都存在的，我也没见过对这种错误的说明，我的提示里有说明这个对象正在被undo使用

龙龙仔

;;程序測試
;;試試以下的程序,使用永久反應裝置
;;進行"undo"操作，也不會有錯誤
;;By 龍龍仔(LUCAS) CL_REACTOR.VLX