数据关联求和与解除

zgssd · 发表于 2013-6-16 10:04

在AutoCAD04中试用很好，谢谢楼主分享。

yx5277 · 发表于 2014-11-16 10:35

用了反应器，如果很多的话会不会很慢？

dbqtju · 发表于 2015-2-4 11:21

学习学习永久反应器

bai2000 · 发表于 2015-2-4 21:48

Gu_xl 发表于 2012-7-13 13:39
数字关联示例代码:

连加是这样，连乘怎么改？

zhaochang71 · 发表于 2015-2-4 22:27

(+ val (atof (dxf en 1)))改为(* val (atof (dxf en 1)))

bai2000 · 发表于 2015-2-6 17:03

zhaochang71 发表于 2015-2-4 22:27
(+ val (atof (dxf en 1)))改为(* val (atof (dxf en 1)))

这样改，不行啊，出现0.000

zhaochang71 · 发表于 2015-2-7 17:49

bai2000 发表于 2015-2-6 17:03
这样改，不行啊，出现0.000

(defun c:tt (/ SS VAL N EN OBJ DATA PT TEXT HAND)
(princ "\n选择文字:")
(setq ss (ssget '((0 . "text"))))
(if ss
(progn
(setq val 1)
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n)))
obj (vlax-ename->vla-object en)
data (cons (dxf en 5) data)
val (* val (atof (dxf en 1)))
)
)
(setq pt (getpoint "\n文字位置:"))
(entmake (list '(0 . "text")
(cons 10 pt)
(cons 1 (rtos val 2))
(cons 40 (dxf en 40))))
(setq text (entlast))
(setq hand (dxf text 5))
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n))))
(vlr-pers ;_ 设置永久反应器
(VLR-Object-Reactor
(list (vlax-ename->vla-object en))
data ;_ 关联的对象索引
'((:VLR-modified . text-change) ;_ 回调函数
)
)
)
(VLAX-LDATA-PUT
(vlax-ename->vla-object En)
"data"
(entget text)
) ;_ 将关联文字数据保存在词典里
)
)
)
)
(defun dxf (e i)
(cdr (assoc i (entget e)))
)
;;回调函数
(defun text-change (Object Reactor-Object Parameter-list
/ hand ent val
data dxfs)
(setq data (vlr-data Reactor-Object))
(setq
hand (cdr (assoc 5 (setq dxfs (VLAX-LDATA-get Object "data")))))
(if (and
hand
(setq ent (handent hand))
(setq el (entget ent))
)
(progn
(setq val
(apply '*
(mapcar
'(lambda (x / e)
(if
(and
(setq e (handent x))
(entget e)
)
(atof (dxf e 1))
0
)
)
data
)
)
)
(entmod (subst (cons 1 (rtos val 2)) (assoc 1 el) el))
)
(progn
(setq val
(apply '*
(mapcar
'(lambda (x / e)
(if
(and
(setq e (handent x))
(entget e)
)
(atof (dxf e 1))
0
)
)
data
)
)
)
(entmake (subst (cons 1 (rtos val 2)) (assoc 1 dxfs) dxfs)) ;_ 恢复关联文字
(setq text (entget (entlast)))
(foreach h data
(if (and
(setq en (handent h))
(entget en)
)
(VLAX-LDATA-PUT (vlax-ename->vla-object En) "data" text) ;_ 重置数据
)
)
)
)
(princ)
)

(defun c:tt  (/  SS VAL N EN OBJ DATA PT TEXT HAND) 
    (princ "\n选择文字:") 
  (setq ss (ssget '((0 . "text")))) 
  (if ss 
    (progn 
      (setq val 1) 
      (repeat (setq n (sslength ss)) 
        (setq en   (ssname ss (setq n (1- n))) 
              obj  (vlax-ename->vla-object en) 
              data (cons (dxf en 5) data) 
              val  (* val (atof (dxf en 1))) 
              ) 
        ) 
      (setq pt (getpoint "\n文字位置:")) 
      (entmake (list '(0 . "text") 
                     (cons 10 pt) 
                     (cons 1 (rtos val 2)) 
                     (cons 40 (dxf en 40)))) 
      (setq text (entlast)) 
      (setq hand (dxf text 5)) 
       
      (repeat (setq n (sslength ss)) 
        (setq en (ssname ss (setq n (1- n)))) 
        (vlr-pers ;_ 设置永久反应器 
          (VLR-Object-Reactor 
            (list (vlax-ename->vla-object en)) 
            data ;_ 关联的对象索引 
            '((:VLR-modified . text-change) ;_ 回调函数 
              ) 
            ) 
          ) 
        (VLAX-LDATA-PUT 
          (vlax-ename->vla-object En) 
          "data" 
          (entget text) 
          ) ;_ 将关联文字数据保存在词典里 
        ) 
      ) 
    ) 
  ) 
(defun dxf  (e i) 
    (cdr (assoc i (entget e))) 
    ) 
;;回调函数 
(defun text-change  (Object         Reactor-Object                 Parameter-list 
                     /                 hand             ent         val 
                     data         dxfs) 
  (setq data (vlr-data Reactor-Object)) 
  (setq 
    hand (cdr (assoc 5 (setq dxfs (VLAX-LDATA-get Object "data"))))) 
  (if (and 
      hand 
        (setq ent (handent hand)) 
        (setq el (entget ent)) 
        ) 
    (progn 
      (setq val 
             (apply '* 
                    (mapcar 
                      '(lambda (x / e) 
                         (if 
                           (and 
                             (setq e (handent x)) 
                             (entget e) 
                             ) 
                            (atof (dxf e 1)) 
                            0 
                            ) 
                         ) 
                      data 
                      ) 
                    ) 
            ) 
      (entmod (subst (cons 1 (rtos val 2)) (assoc 1 el) el)) 
      ) 
    (progn 
      (setq val 
             (apply '* 
                    (mapcar 
                      '(lambda (x / e) 
                         (if 
                           (and 
                             (setq e (handent x)) 
                             (entget e) 
                             ) 
                            (atof (dxf e 1)) 
                            0 
                            ) 
                         ) 
                      data 
                      ) 
                    ) 
            ) 
      (entmake (subst (cons 1 (rtos val 2)) (assoc 1 dxfs) dxfs)) ;_ 恢复关联文字 
      (setq text (entget (entlast))) 
      (foreach h  data 
        (if (and 
              (setq en (handent h)) 
              (entget en) 
              ) 
          (VLAX-LDATA-PUT (vlax-ename->vla-object En) "data" text) ;_ 重置数据 
          ) 
        ) 
      ) 
    ) 
  (princ) 
  )

zhaochang71 · 发表于 2015-2-7 17:52

bai2000 发表于 2015-2-6 17:03
这样改，不行啊，出现0.000

(setq val 0)改为(setq val 1.0)
两个 (apply '+ 改为(apply '*

bai2000 · 发表于 2015-2-7 21:59

谢楼上，好用。怎么把小数点后的0000取消啊？

luojunmax · 发表于 2015-8-25 11:56

谢谢了

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