论坛里一位朋友的文本求和的源码，求帮助完善

yamjqq

前辈们，论坛中有一个文本求和的插件计算比较方便，实在记不清哪位朋友的插件，感谢这位朋友啦。
如下两点稍稍完善就更好用了，前辈们百忙之中麻烦给与指导，谢谢啦，
1、计算式目前在0层，如写到当前层，更为便利。
2、计算式中的“-”号删除了，计算完成需要二次修改，不知“-”号能否保留？

注册

yamjqq 发表于 2019-6-11 16:52
图片上传错了，更换下

(defun c:SZGL  (/  SS VAL N EN OBJ DATA PT TEXT HAND)
    (princ "\n选择文字:")
  (setq ss (ssget '((0 . "text"))))
  (if ss
    (progn
      (setq val 0)
      (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)
  )
拿去，不谢

yamjqq

图片上传错了，更换下

xyp1964

;; 非源码慎用

yamjqq

注册 发表于 2019-6-16 20:42
(defun c:SZGL  (/  SS VAL N EN OBJ DATA PT TEXT HAND)
    (princ "\n选择文字:")
  (setq ss (ssge ...

这几天没来论坛，谢谢您

390311997

谢谢分享！！！！！！

200853006

xyp1964 发表于 2019-6-17 23:08
;; 非源码慎用

还是院长大大强大!

jhzxj

非常好，谢谢，惠存了

jhzxj

非常好用，正需要，谢谢

78946299

留个脚印，以后能用到。