关于反应器的问题。

chg

我写了一个DWG反应器，目的是自动修改文档的存储路径。在使用命令QSAVE,save,saveas时
自动更改我事先写入的路径。但是在加载了这个LISP程序以后，我用CTRL+C进行粘贴复制
时，所选的实体一直保持亮显，直到我用REGEN命令重新生成才会恢复。(当然用别的命令选择这些实体后也会恢复)。我不知道是我的程序有问题还是ACAD本身的问题，想请教各位高手知不知道原因或有没有解决的办法。感激不尽。

mccad

CAD菜鸟

chg

;|全局变量 *drawingreactor*


(defun fn:writeatt (/ tm cvp newatt factor)
  (setq factor (cdr (assoc 41 (entget (tblobjname "style" "text-s")))))
  (if (and (= (setq tm (getvar "tilemode")) 0)
           (= (setq cvp (getvar "cvport")) 1)
      )
    (setq pt pt)
    (setq pt '(0 0 0))
  )
  (if (= (tblsearch "layer" "Tile") nil)
    (command "_.layer" "n" "Tile" "c" 7 "Tile" "")
    )
  (setq        newatt (vla-addattribute
                 (paper-space)
                 2.5
                 0
                 "Acad FilePath & Filename :"
                 (vlax-3d-point pt)
                 "FILENAME"
                 "filename"
               )
  )
  (vla-put-scalefactor newatt factor)
  (vla-put-stylename newatt "text-s")
  (vla-put-layer newatt "Tite")
  (vla-put-color newatt 7)
  newatt
)

(defun fn:changepath-fn        ()
  (setq cnt 0)
  (if attss
    (repeat (sslength attss)
      (setq attnlst (append
                      attnlst
                      (list (vlax-ename->vla-object (ssname attss cnt)))
                    )
            cnt            (1+ cnt)
      )
    )
  )
  (setq        pa   (getvar "dwgprefix")
        fn   (getvar "dwgname")
        pafn (strcase (strcat pa fn))
  )
  (while attnlst
    (setq attname (car attnlst))
    (setq old-pafn (vla-get-tagstring attname))
    (if        (/= pafn old-pafn)
      (progn
        (vla-put-tagstring attname pafn)
        (vla-put-textstring attname pafn)
        )
      )
    (setq attnlst (cdr attnlst))
  )
)

(defun c:fn (/                 pt            attss      pafn          old-pafn
              attname         cnt            attnlst    objrea          old-cmdecho
              old-ortho         old-osmode pa         fn
             )
  (setq old-ortho (getvar "orthomode") old-osmode (getvar "osmode")
        old-cmdecho (getvar "cmdecho")
        )
  (setvar "cmdecho" 0)
  (if (= (tblsearch "STYLE" "text-s") nil)
    (command "style" "text-s" "romans.shx" "0" "0.8" "0" "n" "n" "n")
    )
  (if (= (setq attss (ssget "X"
                            (list (cons 0 "ATTDEF")
                                  (cons 3 "Acad FilePath & Filename :")
                            )
                     )
         )
         nil
      )
    (progn
      (setq pt (getpoint "\nPick insert point of text :"))
      (setq attnlst (list (fn:writeatt)))
      (fn:changepath-fn)
    )
    (fn:changepath-fn)
  )
  (if (not *drawingreactor*)
    (setq *drawingreactor*
           (vlr-dwg-reactor
             nil
             '((:vlr-beginClose . fn:cleanreactors)
               (:vlr-saveComplete . fn:dwg-saved)
                                        ;(:vlr-dwgFileOpened . fn:dwg-opened)
              )
           )
    )
  )
  (setvar "orthomode" old-ortho)
  (setvar "osmode" old-osmode)
  (setvar "cmdecho" old-cmdecho)
  (princ)
)

(defun CleanReactors ()
  (setq
    *drawingreactor*
     nil                                ; clear the variable
  )

  (mapcar 'vlr-remove-all
          '(:VLR-AcDb-reactor                 :VLR-Editor-reactor
            :VLR-Linker-reactor                 :VLR-Object-reactor
            :VLR-Command-Reactor         :VLR-DeepClone-Reactor
            :VLR-DocManager-Reactor         :VLR-DWG-Reactor
            :VLR-DXF-Reactor                 :VLR-Editor-reactor
            :VLR-Insert-Reactor                 :VLR-Linker-Reactor
            :VLR-Lisp-Reactor                 :VLR-Miscellaneous-Reactor
            :VLR-Mouse-Reactor                 :VLR-Object-Reactor
            :VLR-SysVar-Reactor                 :VLR-Toolbar-Reactor
            :VLR-Undo-Reactor                 :VLR-Wblock-Reactor
            :VLR-Window-Reactor                 :VLR-XREF-Reactor
           )
    )
  )

(defun fn:cleanreactors        (reactor_object data)
  (cleanreactors)
)

(defun fn:dwg-saved (reactor_object data)
  (setq        attss (ssget "X"
                     (list (cons 0 "ATTDEF")
                           (cons 3 "Acad FilePath & Filename :")
                     )
              )
       )
  (fn:changepath-fn)
  )

龙龙仔

chg

龙龙仔

(defun FN:DWG-SAVED (REACTOR_OBJECT DATA / N SS)
  (setq SS (ssget "p"))
  (setq        ATTSS (ssget "X"
                     (list (cons 0 "ATTDEF")
                           (cons 3 "Acad FilePath & Filename :")
                     )
              )
  )
  (setq N 0)
  (if (>= (sslength SS) 1)
    (repeat (sslength SS)
      (redraw (ssname SS N) 4)
      (setq N (1+ N))
    )
  )
  (FN:CHANGEPATH-FN)
  ;;(vla-regen (vla-get-activedocument (vlax-get-acad-object))
  ;;acactiveviewport                ;acallviewports
  ;;)
)

chg

虽然解除了亮显，但是多做了工作。我想这可能是AutoCAD本身的一点瑕玭。感谢龙大侠的指点。[br]