关于反应器的问题。

chg · 发表于 2003-1-26 16:35:00

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

chg · 发表于 2003-1-27 10:40:00

;|全局变量 *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)
  )

龙龙仔 · 发表于 2003-1-28 11:14:00

(defun FNWG-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 · 发表于 2003-1-28 16:22:00

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

关于反应器的问题。

发表回复

精选推荐