[分享]：vlisp反应器初探

haijiangl · 发表于 2005-5-17 03:13:29

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

刚编了一个小程序，将图纸中的详图图号和索引符号关联，更改详图图号，索引符号自动更新，大家分享，互相学习！

[FONT=courier new]
;;; 反应器其实是一个autocad的vlr物体，它就像其他cad物体一样，包含很多数据
;;; 在这个程序里，主要用到了反应器内的以下数据：
;;; 1，反应器的所有者，即由何物体触发反应器，通过vlr-owners函数访问
;;; 2，反应器所携带的数据（不是包含），通过vlr-data函数访问
;;; 3，反应器的回调函数，即触发了反应器后，执行什么操作
;;; 反应器与其所有者的关系：
;;; 1，一个所有者 owner 可以拥有多个反应器 reactor
;;; 2，一个反应器 reactor 可以附着在多个所有者 owner
;;; 下面的程序主要用到两个变量
;;; drawno－－详图的编号，块，包含两个属性。其中一个为隐藏属性，表示图号
;;; index －－图纸中的索引，块，包含两个属性。就是大家常见的圆圈，上面是详图号，下面是图号
;;; 本程序的目的是将两者关联，
;;; drawno作为owner，对其编辑将触发反应器，自动更新index
;;; index 作为反应器要进行操作的对象，已数据的形式被反应器所携带
;;; 原则：一个drawno可以带动反应器对多个index修改，因为详图可以被多次索引
;;; 一个index只能被唯一的drawno所控制，因为索引和详图是单一对应的
;;; 下面是几个通用函数，跳过介绍
;==========================
(defun lhj_sel (str fi_list / pt ename ss loop ename)
(princ "\n")
(princ str)
(setq loop T)
(while loop
(setq pt (grread t 4 2))
(if (= 3 (car pt))
(setq loop nil)
)
)
(setq pt (cadr pt))
(setq ss (ssget pt fi_list))
(if ss
(setq ename (ssname ss 0))
(setq ename nil)
)
)
=====================================
;;;获取实体dxf组码内容
;;; (lhj_dxf 实体名 dxf码编号)
;;;例：(lhj_dxf textname 10)，获取文字左下点标
(defun lhj_dxf (ename code / elist res)
(setq elist (entget ename))
(setq res (cdr (assoc code elist)))
)
;;; ==========================================
;;; ;;初始化，读取系统变量。结束时，恢复系统变量
;;; ; osmode 0
;;; ; cmdecho 1
;;; ; clayer 2
;;; ; textstyle 3
;;; ; cecolor 4
;;; ; dimstyle 5
;;; ; plinewid 6
;;; ; filletrad 7
(defun lhj_start ()
(setq lhj_s_lst
(list
(getvar "osmode")
(getvar "cmdecho")
(getvar "clayer")
(getvar "textstyle")
(getvar "cecolor")
(getvar "dimstyle")
(getvar "plinewid")
(getvar "filletrad")
(getvar "attdia")
)
)
(setq old_error *error*)
(setvar "cmdecho" 0)
(command "undo" "be")
(setvar "osmode" 0)
(setvar "attdia" 0)
(princ)
)
(defun lhj_end ()
(setvar "osmode" (nth 0 lhj_s_lst))
(setvar "clayer" (nth 2 lhj_s_lst))
(setvar "textstyle" (nth 3 lhj_s_lst))
(setvar "cecolor" (nth 4 lhj_s_lst))
(command "dimstyle" "r" (nth 5 lhj_s_lst))
(setvar "plinewid" (nth 6 lhj_s_lst))
(setvar "filletrad" (nth 7 lhj_s_lst))
(setvar "attdia" (nth 8 lhj_s_lst))
(setq *error* old_error)
(command "undo" "e")
(setvar "cmdecho" (nth 1 lhj_s_lst))
(princ)
)
;;;
;;;
;;;
;;;
;;;
;;;
;;;
;;;
;;; 开始主要内容了
;;=================================
;;定义dwg文件关闭程序
;;(defun IA:dwgclose ()
;;还没搞定呢，这个函数的规划想法是：在dwg文件关闭的时候，
;;检查无效的反应器，将其删除，
;;因为反应器也是cad的物体，占用文件大小，
;;并且可能带来无法意料的情况
;;一下两段程序可以写在主程序内部，作为内部函数
;;现在写在外部，主要目的是加载了本文件后，
;;就可以对图纸中已经存在的反应器进行操作了，
;;不一定非要运行主程序
;;=================================
;;定义IA:makesame程序，使 drawno 和 index 统一
;;这段很简单，就是一般的lsp操作
(defun IA:makesame (drawno index / attlist dn1 dn2 temp templist)
(setq temp (entnext drawno)
dn1 (lhj_dxf temp 1)
temp (entnext temp)
dn2 (lhj_dxf temp 1)
)
(setq
temp (entnext index)
templist (entget temp)
templist (subst (cons 1 dn1) (assoc 1 templist) templist)
)
(entmod templist)
(setq
temp (entnext temp)
templist (entget temp)
templist (subst (cons 1 dn2) (assoc 1 templist) templist)
)
(entmod templist)
(entupd index)
)
;;=================================
;;定义图号drawno被修改时的程序
;;这个就是回调函数，它需要三个接受变量，这完全是由反映器的类型决定的
;;具体看一下帮助文档吧！
(defun ia:dn_modified
(drawno reactor parameter-list / indextomodifylist x)
(setq indextomodifylist (vlr-data reactor) ;读取反映器附带的数据，
drawno (vlax-vla-object->ename drawno)
)
(foreach x indextomodifylist
;如前所述，要修改的index是可以存在多个的，所以用表来保存
(progn
(setq x (handent x))
(IA:makesame drawno x)
)
) ;end of foreach
)
;;=================================
;;查找由Indexassoc函数产生的反应器
;;返回如下格式的表
;; '((reactor owner data) (reactor owner data) ....)
;;针对indexassoc函数，返回格式为
;; '((reactorA drawnoA '(indexA1 indexA2 indexA3 ...)) (reactorB drawnoB '(indexB1 indexB2 indexB3 ...)) ...)
;;将所有由主程序生成的反应器及其owner和data保存在全局变量*IA:allreactor*中
(defun IA:calreactor (/ all data owner reactor reaction)
(setq *IA:allreactor* '()
all (vlr-pers-list)
)
(foreach x all
(setq reaction (vlr-reactions x))
(if (member '(:VLR-subObjModified . IA:DN_MODIFIED) reaction)
(setq data (vlr-data x)
owner (vlr-owners x)
*IA:allreactor* (cons (list x (car owner) data) *IA:allreactor*)
)
)
)
)
;;;===========================================
;;; 关联索引及图号
;;;下面就是主程序了
(defun c:lhj_IndexAssoc (/ index drawno indexhandle
reactor x re2del dodel
olddata doreset howto re2set
)
;初始化程序=======
(lhj_start)
(defun *error* (msg)
(princ "\n")
(princ "\n:::lhj_tools:::")
(princ msg)
(princ ",程序退出!")
)
;添加关闭图形时的反应器
;
; (if (not *IA:dwgclosereactor*)
; (setq *IA:dwgclosereactor* (vlr-dwg-reactor nil '((vlr-beginClose . IA:dwgclose))))
; )
;未完善，个人体会，反应器程序一定要完善后在发布使用，
;否则一旦更新后的数据格式与以前不同，将造成原来的反应器失效。
;定义反映关联程序，这是主体
(defun ia:makeassoc ()
(IA:calreactor) ;查找图纸中所有由lhj_IndexAssoc生成的反应器
(setq index (vlax-ename->vla-object index)
drawno (vlax-ename->vla-object drawno)
)
(if *IA:allreactor*
(foreach x *IA:allreactor*
(if (member indexhandle (caddr x))
(setq re2del (car x)) ;如果index是某一反应器的处理对象，将该反应器提取，以备后需
)
(if (member drawno x)
(setq olddata (caddr x) ;如果drawno拥有了反映器，将该反应器所携带数据提取
re2set (car x) ;并将该反应器保存，以备后需
)
(setq olddata '())
)
)
)
(if re2del
(progn
(initget "Yes No")
(setq dodel
(getstring
"\n:::TACON:::所选择的[索引]曾被设置关联，是否打断关联？(Yes/No):"
)
)
(if (wcmatch dodel "y*,Y*")
(vlr-remove re2del) ;删除旧反应器，见最上面的原则。
(exit) ;或者退出
)
)
)
(if olddata
(progn
(initget "1 2 3")
(setq howto ;如果drawno拥有反应器，如何操作捏？
(getint
"\n:::TACON:::所选择的[图纸编号]曾被设置关联，如何处理？(1_替换/2_添加/3_退出):"
)
)
(cond ((= howto 1) ;替换，即将新的index替换旧的
(progn (IA:makesame
(vlax-vla-object->ename drawno)
(vlax-vla-object->ename index)
)
(vlr-data-set re2set (list indexhandle))
)
)
((= howto 2) ;添加，即将新的index添加到要被反应器操作的目标中
(progn (IA:makesame
(vlax-vla-object->ename drawno)
(vlax-vla-object->ename index)
)
(vlr-data-set re2set (cons indexhandle olddata))
)
)
((= howto 3) (exit)) ;退出
)
)
(progn ;如果drawno不拥有反应器，那就给他弄一个
(IA:makesame
(vlax-vla-object->ename drawno)
(vlax-vla-object->ename index)
)
(setq reactor
(vlr-object-reactor
(list drawno)
(list indexhandle)
'((:vlr-subObjModified . ia:dn_modified))
)
)
(vlr-pers reactor)
)
)
)
;主程序外框，输入部分===========
(if
(setq index (lhj_sel "\n:::TW:::请选择要进行关联的[索引]:"
'((2 . "lhj_ref"))
)
)
(progn
(redraw index 3)
(if
(setq
drawno
(lhj_sel "\n:::TW:::请选择要与之关联的[详图图号]:"
'((2 . "lhj_drawno"))
)
)
(progn
(redraw index 4)
(setq indexhandle (lhj_dxf index 5)) ;这里把index的handle作为数据储存，而没有使用objname
(IA:makeassoc) ;是因为用户在undo和oops后，名字会变，而handle不变
)
(progn
(redraw index 4)
(princ "\n:::TW:::没有选择到[详图图号]!")
)
)
)
(princ "\n:::TW:::没有选择到[索引]!")
)
;主程序结束=======
(lhj_end)
(princ)
)
[/FONT]

[FONT=courier new] 
 
;;; 反应器其实是一个autocad的vlr物体，它就像其他cad物体一样，包含很多数据 
;;; 在这个程序里，主要用到了反应器内的以下数据： 
;;; 1，反应器的所有者，即由何物体触发反应器，通过vlr-owners函数访问 
;;; 2，反应器所携带的数据（不是包含），通过vlr-data函数访问 
;;; 3，反应器的回调函数，即触发了反应器后，执行什么操作 
 
;;; 反应器与其所有者的关系： 
;;; 1，一个所有者  owner    可以拥有多个反应器    reactor 
;;; 2，一个反应器  reactor  可以附着在多个所有者  owner 
 
;;; 下面的程序主要用到两个变量 
;;; drawno－－详图的编号，块，包含两个属性。其中一个为隐藏属性，表示图号 
;;; index －－图纸中的索引，块，包含两个属性。就是大家常见的圆圈，上面是详图号，下面是图号 
;;; 本程序的目的是将两者关联， 
;;; drawno作为owner，对其编辑将触发反应器，自动更新index 
;;; index 作为反应器要进行操作的对象，已数据的形式被反应器所携带 
;;; 原则：一个drawno可以带动反应器对多个index修改，因为详图可以被多次索引 
;;;       一个index只能被唯一的drawno所控制，因为索引和详图是单一对应的 
 
 
;;; 下面是几个通用函数，跳过介绍 
 
  ;========================== 
(defun lhj_sel (str fi_list / pt ename ss loop ename) 
  (princ "\n") 
  (princ str) 
  (setq loop T) 
 
  (while loop 
    (setq pt (grread t 4 2)) 
    (if        (= 3 (car pt)) 
      (setq loop nil) 
    ) 
  ) 
  (setq pt (cadr pt)) 
  (setq ss (ssget pt fi_list)) 
  (if ss 
    (setq ename (ssname ss 0)) 
    (setq ename nil) 
  ) 
) 
 
===================================== 
;;;获取实体dxf组码内容 
;;; (lhj_dxf 实体名 dxf码编号) 
;;;例：(lhj_dxf textname 10)，获取文字左下点标 
 
(defun lhj_dxf (ename code / elist res) 
  (setq elist (entget ename)) 
  (setq res (cdr (assoc code elist))) 
) 
 
;;;  ========================================== 
;;;  ;;初始化，读取系统变量。结束时，恢复系统变量 
;;;  ;  osmode             0 
;;;  ;  cmdecho         1 
;;;  ;  clayer             2 
;;;  ;  textstyle          3 
;;;  ;  cecolor        4 
;;;  ;  dimstyle        5 
;;;  ;  plinewid    6 
;;;  ;  filletrad   7 
 
 
(defun lhj_start () 
  (setq        lhj_s_lst 
         (list 
           (getvar "osmode") 
           (getvar "cmdecho") 
           (getvar "clayer") 
           (getvar "textstyle") 
           (getvar "cecolor") 
           (getvar "dimstyle") 
           (getvar "plinewid") 
           (getvar "filletrad") 
           (getvar "attdia") 
         ) 
  ) 
  (setq old_error *error*) 
  (setvar "cmdecho" 0) 
  (command "undo" "be") 
  (setvar "osmode" 0) 
  (setvar "attdia" 0) 
  (princ) 
) 
 
 
(defun lhj_end () 
  (setvar "osmode" (nth 0 lhj_s_lst)) 
  (setvar "clayer" (nth 2 lhj_s_lst)) 
  (setvar "textstyle" (nth 3 lhj_s_lst)) 
  (setvar "cecolor" (nth 4 lhj_s_lst)) 
  (command "dimstyle" "r" (nth 5 lhj_s_lst)) 
  (setvar "plinewid" (nth 6 lhj_s_lst)) 
  (setvar "filletrad" (nth 7 lhj_s_lst)) 
  (setvar "attdia" (nth 8 lhj_s_lst)) 
  (setq *error* old_error) 
  (command "undo" "e") 
  (setvar "cmdecho" (nth 1 lhj_s_lst)) 
  (princ) 
) 
 
;;; 
;;; 
;;; 
;;; 
;;; 
;;; 
;;; 
;;; 
;;; 开始主要内容了 
 
 
;;================================= 
;;定义dwg文件关闭程序 
;;(defun IA:dwgclose () 
;;还没搞定呢，这个函数的规划想法是：在dwg文件关闭的时候， 
;;检查无效的反应器，将其删除， 
;;因为反应器也是cad的物体，占用文件大小， 
;;并且可能带来无法意料的情况 
 
 
;;一下两段程序可以写在主程序内部，作为内部函数 
;;现在写在外部，主要目的是加载了本文件后， 
;;就可以对图纸中已经存在的反应器进行操作了， 
;;不一定非要运行主程序 
 
;;================================= 
;;定义IA:makesame程序，使 drawno 和 index 统一 
;;这段很简单，就是一般的lsp操作 
(defun IA:makesame (drawno index / attlist dn1 dn2 temp templist) 
  (setq        temp (entnext drawno) 
        dn1  (lhj_dxf temp 1) 
        temp (entnext temp) 
        dn2  (lhj_dxf temp 1) 
  ) 
  (setq 
    temp     (entnext index) 
    templist (entget temp) 
    templist (subst (cons 1 dn1) (assoc 1 templist) templist) 
  ) 
  (entmod templist) 
  (setq 
    temp     (entnext temp) 
    templist (entget temp) 
    templist (subst (cons 1 dn2) (assoc 1 templist) templist) 
  ) 
  (entmod templist) 
  (entupd index) 
) 
 
 
 
;;================================= 
;;定义图号drawno被修改时的程序 
;;这个就是回调函数，它需要三个接受变量，这完全是由反映器的类型决定的 
;;具体看一下帮助文档吧！ 
(defun ia:dn_modified 
       (drawno reactor parameter-list / indextomodifylist x) 
  (setq        indextomodifylist (vlr-data reactor) ;读取反映器附带的数据， 
        drawno                  (vlax-vla-object->ename drawno) 
  ) 
  (foreach x indextomodifylist 
  ;如前所述，要修改的index是可以存在多个的，所以用表来保存 
    (progn 
      (setq x (handent x)) 
      (IA:makesame drawno x) 
    ) 
  ) ;end of foreach 
) 
 
 
;;================================= 
;;查找由Indexassoc函数产生的反应器 
;;返回如下格式的表 
;; '((reactor owner data) (reactor owner data) ....) 
;;针对indexassoc函数，返回格式为 
;; '((reactorA drawnoA '(indexA1 indexA2 indexA3 ...)) (reactorB drawnoB '(indexB1 indexB2 indexB3 ...)) ...) 
;;将所有由主程序生成的反应器及其owner和data保存在全局变量*IA:allreactor*中 
(defun IA:calreactor (/ all data owner reactor reaction) 
  (setq        *IA:allreactor*        '() 
        all                (vlr-pers-list) 
  ) 
  (foreach x all 
    (setq reaction (vlr-reactions x)) 
    (if        (member '(:VLR-subObjModified . IA:DN_MODIFIED) reaction) 
      (setq data            (vlr-data x) 
            owner            (vlr-owners x) 
            *IA:allreactor* (cons (list x (car owner) data) *IA:allreactor*) 
      ) 
    ) 
  ) 
) 
 
 
;;;=========================================== 
;;;    关联索引及图号 
;;;下面就是主程序了 
(defun c:lhj_IndexAssoc        (/           index     drawno    indexhandle 
                         reactor   x             re2del    dodel 
                         olddata   doreset   howto     re2set 
                        ) 
 
  ;初始化程序======= 
  (lhj_start) 
  (defun *error* (msg) 
    (princ "\n") 
    (princ "\n:::lhj_tools:::") 
    (princ msg) 
    (princ ",程序退出!") 
  ) 
 
 
  ;添加关闭图形时的反应器 
  ; 
  ;  (if (not *IA:dwgclosereactor*) 
  ;    (setq *IA:dwgclosereactor* (vlr-dwg-reactor nil '((vlr-beginClose . IA:dwgclose)))) 
  ;   ) 
  ;未完善，个人体会，反应器程序一定要完善后在发布使用， 
  ;否则一旦更新后的数据格式与以前不同，将造成原来的反应器失效。 
 
 
  ;定义反映关联程序，这是主体 
  (defun ia:makeassoc () 
    (IA:calreactor) ;查找图纸中所有由lhj_IndexAssoc生成的反应器 
    (setq index         (vlax-ename->vla-object index) 
          drawno (vlax-ename->vla-object drawno) 
    ) 
 
    (if        *IA:allreactor* 
      (foreach x *IA:allreactor* 
        (if (member indexhandle (caddr x)) 
          (setq re2del (car x)) ;如果index是某一反应器的处理对象，将该反应器提取，以备后需 
        ) 
        (if (member drawno x) 
          (setq        olddata        (caddr x) ;如果drawno拥有了反映器，将该反应器所携带数据提取 
                re2set        (car x)   ;并将该反应器保存，以备后需 
          ) 
          (setq olddata '()) 
        ) 
      ) 
    ) 
 
    (if        re2del 
      (progn 
        (initget "Yes No") 
        (setq dodel 
               (getstring 
                 "\n:::TACON:::所选择的[索引]曾被设置关联，是否打断关联？(Yes/No):" 
               ) 
        ) 
        (if (wcmatch dodel "y*,Y*") 
          (vlr-remove re2del) ;删除旧反应器，见最上面的原则。 
          (exit)              ;或者退出 
        ) 
      ) 
    ) 
 
    (if        olddata 
      (progn 
        (initget "1 2 3") 
        (setq howto     ;如果drawno拥有反应器，如何操作捏？ 
               (getint 
                 "\n:::TACON:::所选择的[图纸编号]曾被设置关联，如何处理？(1_替换/2_添加/3_退出):" 
               ) 
        ) 
        (cond ((= howto 1) ;替换，即将新的index替换旧的 
               (progn (IA:makesame 
                        (vlax-vla-object->ename drawno) 
                        (vlax-vla-object->ename index) 
                      ) 
                      (vlr-data-set re2set (list indexhandle)) 
               ) 
              ) 
              ((= howto 2) ;添加，即将新的index添加到要被反应器操作的目标中 
               (progn (IA:makesame 
                        (vlax-vla-object->ename drawno) 
                        (vlax-vla-object->ename index) 
                      ) 
                      (vlr-data-set re2set (cons indexhandle olddata)) 
               ) 
              ) 
              ((= howto 3) (exit)) ;退出 
        ) 
      ) 
      (progn  ;如果drawno不拥有反应器，那就给他弄一个 
        (IA:makesame 
          (vlax-vla-object->ename drawno) 
          (vlax-vla-object->ename index) 
        ) 
        (setq reactor 
               (vlr-object-reactor 
                 (list drawno) 
                 (list indexhandle) 
                 '((:vlr-subObjModified . ia:dn_modified)) 
               ) 
        ) 
        (vlr-pers reactor) 
      ) 
    ) 
  ) 
 
 
  ;主程序外框，输入部分=========== 
  (if 
    (setq index        (lhj_sel "\n:::TW:::请选择要进行关联的[索引]:" 
                         '((2 . "lhj_ref")) 
                ) 
    ) 
     (progn 
       (redraw index 3) 
       (if 
         (setq 
           drawno 
            (lhj_sel "\n:::TW:::请选择要与之关联的[详图图号]:" 
                     '((2 . "lhj_drawno")) 
            ) 
         ) 
          (progn 
            (redraw index 4) 
            (setq indexhandle (lhj_dxf index 5)) ;这里把index的handle作为数据储存，而没有使用objname 
            (IA:makeassoc)                       ;是因为用户在undo和oops后，名字会变，而handle不变 
          ) 
          (progn 
            (redraw index 4) 
            (princ "\n:::TW:::没有选择到[详图图号]!") 
          ) 
       ) 
     ) 
     (princ "\n:::TW:::没有选择到[索引]!") 
  ) 
 
 
  ;主程序结束======= 
 
  (lhj_end) 
  (princ) 
) 
 
  [/FONT]

附件中包含lisp文件和一个dwg文件，里面有程序需要的图块，大家试试！

啵浪鼓 · 发表于 2005-5-17 13:00:41

感谢分享，顶！

rockes · 发表于 2005-5-18 11:05:51

不错，可以考虑将很多的同样的修改作为同一个块考虑了

jinsong-liao · 发表于 2005-5-18 11:50:12

论坛中关于反应器的讨论真的不多，值得奖励，期待有更多关于反应器的文章或程序贴上来与大家分享！

haijiangl · 发表于 2005-5-18 13:55:55

更新了一部分代码，加载前把一楼的通用函数部分复制到这个程序的前面。

[FONT=courier new]
;;=================================
;;定义IA:makesame程序，使 drawno 和 index 统一
;;这段很简单，就是一般的lsp操作
(defun IA:makesame (drawno index / attlist dn1 dn2 temp templist)
(setq temp (entnext drawno)
dn1 (lhj_dxf temp 1)
temp (entnext temp)
dn2 (lhj_dxf temp 1)
)
(setq
temp (entnext index)
templist (entget temp)
templist (subst (cons 1 dn1) (assoc 1 templist) templist)
)
(entmod templist)
(setq
temp (entnext temp)
templist (entget temp)
templist (subst (cons 1 dn2) (assoc 1 templist) templist)
)
(entmod templist)
(entupd index)
)
;;=================================
;;定义图号drawno被修改时的程序
;;这个就是回调函数，它需要三个接受变量，这完全是由反映器的类型决定的
;;具体看一下帮助文档吧！
(defun ia:dn_modified
(drawno reactor parameter-list / indextomodifylist x)
(setq indextomodifylist (vlr-data reactor) ;读取反映器附带的数据，
drawno (vlax-vla-object->ename drawno)
)
(foreach x indextomodifylist
;如前所述，要修改的index是可以存在多个的，所以用表来保存
(progn
(setq x (handent x))
(IA:makesame drawno x)
)
) ;end of foreach
)
;;=================================
;;查找由Indexassoc函数产生的反应器
;;返回如下格式的表
;; '((reactor owner data) (reactor owner data) ....)
;;针对indexassoc函数，返回格式为
;; '((reactorA drawnoA '(indexA1 indexA2 indexA3 ...)) (reactorB drawnoB '(indexB1 indexB2 indexB3 ...)) ...)
;;将所有由主程序生成的反应器及其owner和data保存在全局变量*IA:allreactor*中
(defun IA:calreactor (/ all data owner reactor reaction)
(setq *IA:allreactor* '()
all (vlr-pers-list)
)
(foreach x all
(setq reaction (vlr-reactions x))
(if (member '(:VLR-subObjModified . IA:DN_MODIFIED) reaction)
(setq data (vlr-data x)
owner (vlr-owners x)
*IA:allreactor* (cons (list x (car owner) data) *IA:allreactor*)
)
)
)
)
;;===================================
;;定义程序存盘反应器的回调函数
;;更新的内容
;;在acad存盘的之前，搜索所有的由IA创建的反应器
;;对于每一个反应器，判断如下内容
;;是否该反应器的owner还存在？
;;是否该反应器携带数据中的index还存在？
;;如果不存在，把该反应器列为无效的
;;提示用户，是否删除这些反应器
;;之所以不直接删除，是以防用户继续绘图，并使用undo命令，
;;恢复了owner和index。
(defun IA:dwgclose
(reactor paralist / x y newdata olddata dodel all2del)
(IA:calreactor)
(setq all2del '())
;---------------
(defun IA:delreactor (del)
(foreach n del
(vlr-pers-release n)
(vlr-remove n)
)
)
;---------------
(setq n 0)
(if *IA:allreactor*
(foreach x *IA:allreactor*
(if (= (cadr x) nil)
(setq all2del (cons (car x) all2del))
(if (= (vlax-vla-object->ename (cadr x)) nil)
(setq all2del (cons (car x) all2del))
(progn
(setq olddata (caddr x)
newdata '()
)
(foreach y olddata
(if (/= (entget (handent y)) nil)
(setq newdata (cons y newdata))
)
(if (= newdata '())
(setq all2del (cons (car x) all2del))
(vlr-data-set (car x) newdata)
)
)
)
)
)
)
)
(if all2del
(progn
(princ (strcat "\n:::TW:::lhj_IndexAssoc程序共搜索到"
(itoa (length all2del))
"个无效的反应器，是否删除？"
)
)
(initget "Yes No")
(setq dodel (getstring "(Yes/No)"))
(if (wcmatch dodel "y*,Y*")
(IA:delreactor all2del)
)
)
)
(princ)
)
;;;===========================================
;;; 关联索引及图号
;;;下面就是主程序了
(defun c:lhj_IndexAssoc (/ index drawno indexhandle
reactor x re2del dodel
olddata doreset howto re2set
)
;初始化程序=======
(lhj_start)
(defun *error* (msg)
(princ "\n")
(princ "\n:::lhj_tools:::")
(princ msg)
(princ ",程序退出!")
)
;添加开始保存图形时的反应器
;
(if (not *IA:beginSavereactor*)
(setq *IA:beginSavereactor*
(vlr-dwg-reactor
nil
'((:vlr-beginSave . IA:dwgclose))
)
)
)
;定义反映关联程序，这是主体
(defun ia:makeassoc ()
(IA:calreactor) ;查找图纸中所有由lhj_IndexAssoc生成的反应器
(setq index (vlax-ename->vla-object index)
drawno (vlax-ename->vla-object drawno)
)
(if *IA:allreactor*
(foreach x *IA:allreactor*
(if (member indexhandle (caddr x))
(setq re2del (car x))
;如果index是某一反应器的处理对象，将该反应器提取，以备后需
)
(if (member drawno x)
(setq olddata (caddr x)
;如果drawno拥有了反映器，将该反应器所携带数据提取
re2set (car x) ;并将该反应器保存，以备后需
)
(setq olddata '())
)
)
)
(if re2del
(progn
(initget "Yes No")
(setq dodel
(getstring
"\n:::TACON:::所选择的[索引]曾被设置关联，是否打断关联？(Yes/No):"
)
)
(if (wcmatch dodel "y*,Y*")
(progn
(vlr-pers-release re2del)
(vlr-remove re2del) ;删除旧反应器，见最上面的原则。
)
(exit) ;或者退出
)
)
)
(if olddata
(progn
(initget "1 2 3")
(setq howto ;如果drawno拥有反应器，如何操作捏？
(getint
"\n:::TACON:::所选择的[图纸编号]曾被设置关联，如何处理？(1_替换/2_添加/3_退出):"
)
)
(cond ((= howto 1) ;替换，即将新的index替换旧的
(progn (IA:makesame
(vlax-vla-object->ename drawno)
(vlax-vla-object->ename index)
)
(vlr-data-set re2set (list indexhandle))
)
)
((= howto 2)
;添加，即将新的index添加到要被反应器操作的目标中
(progn
(IA:makesame
(vlax-vla-object->ename drawno)
(vlax-vla-object->ename index)
)
(if (not (member indexhandle olddata))
(vlr-data-set re2set (cons indexhandle olddata))
)
)
)
((= howto 3) (exit)) ;退出
)
)
(progn ;如果drawno不拥有反应器，那就给他弄一个
(IA:makesame
(vlax-vla-object->ename drawno)
(vlax-vla-object->ename index)
)
(setq reactor
(vlr-object-reactor
(list drawno)
(list indexhandle)
'((:vlr-subObjModified . ia:dn_modified))
)
)
(vlr-pers reactor)
)
)
)
;主程序外框，输入部分===========
(if
(setq index (lhj_sel "\n:::TW:::请选择要进行关联的[索引]:"
'((2 . "lhj_ref"))
)
)
(progn
(redraw index 3)
(if
(setq
drawno
(lhj_sel "\n:::TW:::请选择要与之关联的[详图图号]:"
'((2 . "lhj_drawno"))
)
)
(progn
(redraw index 4)
(setq indexhandle (lhj_dxf index 5))
;;这里把index的handle作为数据储存，而没有使用objname
(IA:makeassoc)
;是因为用户在undo和oops后，名字会变，而handle不变
)
(progn
(redraw index 4)
(princ "\n:::TW:::没有选择到[详图图号]!")
)
)
)
(princ "\n:::TW:::没有选择到[索引]!")
)
;主程序结束=======
(lhj_end)
(princ)
)
[/FONT]

[FONT=courier new] 
 
;;================================= 
;;定义IA:makesame程序，使 drawno 和 index 统一 
;;这段很简单，就是一般的lsp操作 
(defun IA:makesame (drawno index / attlist dn1 dn2 temp templist) 
  (setq        temp (entnext drawno) 
        dn1  (lhj_dxf temp 1) 
        temp (entnext temp) 
        dn2  (lhj_dxf temp 1) 
  ) 
  (setq 
    temp     (entnext index) 
    templist (entget temp) 
    templist (subst (cons 1 dn1) (assoc 1 templist) templist) 
  ) 
  (entmod templist) 
  (setq 
    temp     (entnext temp) 
    templist (entget temp) 
    templist (subst (cons 1 dn2) (assoc 1 templist) templist) 
  ) 
  (entmod templist) 
  (entupd index) 
) 
 
 
 
;;================================= 
;;定义图号drawno被修改时的程序 
;;这个就是回调函数，它需要三个接受变量，这完全是由反映器的类型决定的 
;;具体看一下帮助文档吧！ 
(defun ia:dn_modified 
       (drawno reactor parameter-list / indextomodifylist x) 
  (setq        indextomodifylist (vlr-data reactor) ;读取反映器附带的数据， 
        drawno                  (vlax-vla-object->ename drawno) 
  ) 
  (foreach x indextomodifylist 
  ;如前所述，要修改的index是可以存在多个的，所以用表来保存 
    (progn 
      (setq x (handent x)) 
      (IA:makesame drawno x) 
    ) 
  ) ;end of foreach 
) 
 
 
;;================================= 
;;查找由Indexassoc函数产生的反应器 
;;返回如下格式的表 
;; '((reactor owner data) (reactor owner data) ....) 
;;针对indexassoc函数，返回格式为 
;; '((reactorA drawnoA '(indexA1 indexA2 indexA3 ...)) (reactorB drawnoB '(indexB1 indexB2 indexB3 ...)) ...) 
;;将所有由主程序生成的反应器及其owner和data保存在全局变量*IA:allreactor*中 
(defun IA:calreactor (/ all data owner reactor reaction) 
  (setq        *IA:allreactor*        '() 
        all                (vlr-pers-list) 
  ) 
  (foreach x all 
    (setq reaction (vlr-reactions x)) 
    (if        (member '(:VLR-subObjModified . IA:DN_MODIFIED) reaction) 
      (setq data            (vlr-data x) 
            owner            (vlr-owners x) 
            *IA:allreactor* (cons (list x (car owner) data) *IA:allreactor*) 
      ) 
    ) 
  ) 
) 
 
 
;;=================================== 
;;定义程序存盘反应器的回调函数 
;;更新的内容 
;;在acad存盘的之前，搜索所有的由IA创建的反应器 
;;对于每一个反应器，判断如下内容 
;;是否该反应器的owner还存在？ 
;;是否该反应器携带数据中的index还存在？ 
;;如果不存在，把该反应器列为无效的 
;;提示用户，是否删除这些反应器 
;;之所以不直接删除，是以防用户继续绘图，并使用undo命令， 
;;恢复了owner和index。 
 
(defun IA:dwgclose 
       (reactor paralist / x y newdata olddata dodel all2del) 
 
  (IA:calreactor) 
  (setq all2del '()) 
 
  ;--------------- 
  (defun IA:delreactor (del) 
    (foreach n del 
      (vlr-pers-release n) 
      (vlr-remove n) 
    ) 
  ) 
 
  ;--------------- 
  (setq n 0) 
  (if *IA:allreactor* 
    (foreach x *IA:allreactor* 
      (if (= (cadr x) nil) 
        (setq all2del (cons (car x) all2del)) 
        (if (= (vlax-vla-object->ename (cadr x)) nil) 
          (setq all2del (cons (car x) all2del)) 
          (progn 
            (setq olddata (caddr x) 
                  newdata '() 
            ) 
            (foreach y olddata 
              (if (/= (entget (handent y)) nil) 
                (setq newdata (cons y newdata)) 
              ) 
              (if (= newdata '()) 
                (setq all2del (cons (car x) all2del)) 
                (vlr-data-set (car x) newdata) 
              ) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
 
  (if all2del 
    (progn 
      (princ (strcat "\n:::TW:::lhj_IndexAssoc程序共搜索到" 
                     (itoa (length all2del)) 
                     "个无效的反应器，是否删除？" 
             ) 
      ) 
      (initget "Yes No") 
      (setq dodel (getstring "(Yes/No)")) 
      (if (wcmatch dodel "y*,Y*") 
        (IA:delreactor all2del) 
      ) 
    ) 
  ) 
 
  (princ) 
) 
 
 
 
;;;=========================================== 
;;;    关联索引及图号 
;;;下面就是主程序了 
(defun c:lhj_IndexAssoc        (/           index     drawno    indexhandle 
                         reactor   x             re2del    dodel 
                         olddata   doreset   howto     re2set 
                        ) 
 
  ;初始化程序======= 
  (lhj_start) 
  (defun *error* (msg) 
    (princ "\n") 
    (princ "\n:::lhj_tools:::") 
    (princ msg) 
    (princ ",程序退出!") 
  ) 
 
 
  ;添加开始保存图形时的反应器 
  ; 
  (if (not *IA:beginSavereactor*) 
    (setq *IA:beginSavereactor* 
           (vlr-dwg-reactor 
             nil 
             '((:vlr-beginSave . IA:dwgclose)) 
           ) 
    ) 
  ) 
 
 
  ;定义反映关联程序，这是主体 
  (defun ia:makeassoc () 
    (IA:calreactor) ;查找图纸中所有由lhj_IndexAssoc生成的反应器 
    (setq index         (vlax-ename->vla-object index) 
          drawno (vlax-ename->vla-object drawno) 
    ) 
 
    (if        *IA:allreactor* 
      (foreach x *IA:allreactor* 
        (if (member indexhandle (caddr x)) 
          (setq re2del (car x)) 
  ;如果index是某一反应器的处理对象，将该反应器提取，以备后需 
        ) 
        (if (member drawno x) 
          (setq        olddata        (caddr x) 
  ;如果drawno拥有了反映器，将该反应器所携带数据提取 
                re2set        (car x) ;并将该反应器保存，以备后需 
          ) 
          (setq olddata '()) 
        ) 
      ) 
    ) 
 
    (if        re2del 
      (progn 
        (initget "Yes No") 
        (setq dodel 
               (getstring 
                 "\n:::TACON:::所选择的[索引]曾被设置关联，是否打断关联？(Yes/No):" 
               ) 
        ) 
        (if (wcmatch dodel "y*,Y*") 
                       (progn 
                         (vlr-pers-release re2del) 
            (vlr-remove re2del) ;删除旧反应器，见最上面的原则。 
             ) 
          (exit) ;或者退出 
        ) 
      ) 
    ) 
 
    (if        olddata 
      (progn 
        (initget "1 2 3") 
        (setq howto ;如果drawno拥有反应器，如何操作捏？ 
               (getint 
                 "\n:::TACON:::所选择的[图纸编号]曾被设置关联，如何处理？(1_替换/2_添加/3_退出):" 
               ) 
        ) 
        (cond ((= howto 1) ;替换，即将新的index替换旧的 
               (progn (IA:makesame 
                        (vlax-vla-object->ename drawno) 
                        (vlax-vla-object->ename index) 
                      ) 
                      (vlr-data-set re2set (list indexhandle)) 
               ) 
              ) 
              ((= howto 2) 
  ;添加，即将新的index添加到要被反应器操作的目标中 
               (progn 
                 (IA:makesame 
                   (vlax-vla-object->ename drawno) 
                   (vlax-vla-object->ename index) 
                 ) 
                 (if (not (member indexhandle olddata)) 
                   (vlr-data-set re2set (cons indexhandle olddata)) 
                 ) 
               ) 
              ) 
              ((= howto 3) (exit)) ;退出 
        ) 
      ) 
      (progn ;如果drawno不拥有反应器，那就给他弄一个 
        (IA:makesame 
          (vlax-vla-object->ename drawno) 
          (vlax-vla-object->ename index) 
        ) 
        (setq reactor 
               (vlr-object-reactor 
                 (list drawno) 
                 (list indexhandle) 
                 '((:vlr-subObjModified . ia:dn_modified)) 
               ) 
        ) 
        (vlr-pers reactor) 
      ) 
    ) 
  ) 
 
 
  ;主程序外框，输入部分=========== 
  (if 
    (setq index        (lhj_sel "\n:::TW:::请选择要进行关联的[索引]:" 
                         '((2 . "lhj_ref")) 
                ) 
    ) 
     (progn 
       (redraw index 3) 
       (if 
         (setq 
           drawno 
            (lhj_sel "\n:::TW:::请选择要与之关联的[详图图号]:" 
                     '((2 . "lhj_drawno")) 
            ) 
         ) 
          (progn 
            (redraw index 4) 
            (setq indexhandle (lhj_dxf index 5)) 
  ;;这里把index的handle作为数据储存，而没有使用objname 
            (IA:makeassoc) 
  ;是因为用户在undo和oops后，名字会变，而handle不变 
          ) 
          (progn 
            (redraw index 4) 
            (princ "\n:::TW:::没有选择到[详图图号]!") 
          ) 
       ) 
     ) 
     (princ "\n:::TW:::没有选择到[索引]!") 
  ) 
 
 
  ;主程序结束======= 
 
  (lhj_end) 
  (princ) 
) 
  [/FONT]

临时反应器随dwg文件的关闭将删除
永久反应器作为一个vla对象，保存在dwg文件中
要删除永久反应器，先要释放它，使之成为临时反应器
(vlr-pers reactor)函数使反应器成为永久反应器
(vlr-pers-release reactor)函数释放永久反应器
(vlr-remove reactor)删除反应器

sz_getdown · 发表于 2005-5-19 12:44:35

正想学习这方面的内容呢，可惜一时还没看明白。谢谢

ysx810210 · 发表于 2005-5-19 17:14:12

反应器的资料看过，不太了解，学习中......

fish710605 · 发表于 2005-5-20 16:31:17

楼主的功力蛮深厚的，反应器我也正在学习中！

LUCAS · 发表于 2005-5-23 09:36:19

;;樓主程序有一個致命的缺點
;;當它與別的程序(某些永久反應器程序---如我所附的程序,指令:sample---
;;請把圖tr.dwg與sample.vlx放在同一目錄)一起使用時,會有一個現象,
;;當你不冊除反應器時,圖檔存檔再打開,程序都能保持永久反應器
;;但當你冊除反應器再存檔打開時,你的永久反應器將失效......
;;並會提示:error: no function definition: IA:DN_MODIFIED
;;我可沒有故意寫程序來影嚮你的程序!你可用別的類似結構的程序試試!

;;PS:sample.vlx---以線未點為圓心,周長等於線長的永久反應器

firstintimate · 发表于 2005-5-23 10:28:09

谢谢楼主，现在这方面的内容挺难找的～

fish710605 · 发表于 2005-5-23 13:02:36

顶，ACTIVEX正在学习之中！好资料啊！

haijiangl · 发表于 2005-5-23 15:40:41

LUCAS ，能把你程序的源码发给我么？
好像你的tr.dwg自动加载sample.vlx，应该是有一个永久反应器保存在dwg文件中的，
你所说的问题的确存在，即使不删除我所定义的永久反应器，问题也重现了。
我不知道你的程序在dwg退出时，是否有反应器。

LUCAS · 发表于 2005-5-23 16:58:55

1.不是好像----確實是---只要打開tr.dwg圖檔就會自動載入sample.vlx(放在一起的話…)
2.dwg退出時，沒有反應器(你的寫法,我以前也用過…..後來發現那致命的缺點就不用了!)
3.其實最後連打開圖檔自動載入vlx也放棄不用,因自動載入vlx有點危險
(有心人會改為病毒….它不像vba會有警告對話框,程序要做甚麼都可以
……危險…..希望不會發生) 8-(

haijiangl · 发表于 2005-5-23 20:06:28

Lucas，能看一下你的源码么，不然我还是搞不懂哪里造成的冲突。

LUCAS · 发表于 2005-5-24 08:18:47

我也還在找造成冲突的原因, 猜想是獨立變量空間的bug, 它影嚮了其他程序,看來是autocad某些結構的問題,

Reply From: Tanzillo, Tony
Date: Sep/18/03 - 09:06 (GMT)

Re:
You don't remove reactors from erased objects, because
they can be unerased (UNDO, OOPS, etc.).
;;永久反應器的麻煩 > 它的好處 ---------8-(
My advice is to avoid persistent reactors entirely as
they're far more trouble than they're worth, even if
they did work correctly.

You can just attach data (e.g., extension dictionaries
with an xrecord) to objects, and when a drawing is opened,
you find and attach non-persistent reactors to all those
objects.

账号		自动登录	找回密码
密码			立即注册

[分享]：vlisp反应器初探

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子