文本运算求助

77077 · 发表于 2014-7-15 17:15:11

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

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

×

下面这个程序是选择一个数与另一个数就行运算,存在好多问题,求大神出手完善!另外想请高手帮忙修改成,选择一组数与另一组数运算,结果存为第三组数
关键是想看看ss1中,如何分别取出文本存为lst1

(defun c:tt ( / en1 en2 h lay x1 x2 x3 pt)
(setq kk (getint "\n选择集运算,请选择运算符[1-加 2-减 3-乘 4-除 5-百分比]:"))
(setq en1 (entget (car(entsel "\n选择第一个数字")))
en2 (entget (car(entsel "\n选择第二个数字")))
h (cdr(assoc 40 en1))
lay (cdr(assoc 8 en1))
x1 (atof(cdr(assoc 1 en1)))
x2 (atof(cdr(assoc 1 en2)))
)
(cond
((= kk 1) (setq x3 (rtos (+ x1 x2) 2 2)))
((= kk 2) (setq x3 (rtos (- x1 x2) 2 2)))
((= kk 3) (setq x3 (rtos (* x1 x2) 2 2)))
((= kk 4) (setq x3 (rtos (/ x1 x2) 2 2)))
((= kk 5) (setq x3 (strcat (rtos (* (/ x1 x2) 100) 2 2) "%")))
(T (progn (princ "\n运算符不正确,系统强制进行加法运算!")(setq x3 (rtos (+ x1 x2) 2 2))))
)
(setq pt (getpoint "\n请选择输出位置:"))
(entmake (list '(0 . "text") (cons 1 x3) (cons 8 lay) (cons 10 pt) (cons 11 pt)(cons 72 1)(cons 73 2) (cons 40 h)))
(princ)
)

st788796 · 发表于 2014-7-15 23:51:14

这种程序有太多版本了，楼下就有高飞鸟版主写的一个

本来用惯了 XDAPI，现在用的电脑只有 AutoCAD 2015 ，用了一个 ET 函数简单写了一个, 写文字部分自己加上即可

(defun c:tt (/ tf Gettotle1 GetTotle ss key code val)
(defun GetTotle (ss func)
(apply func
(mapcar '(lambda (x)
(distof (cdr (assoc 1 (entget x))))
)
(acet-ss-to-list ss)
)
)
)
(defun Gettotle1 (str str1 func func1 / e num n)
(if (and (progn
(princ str)
(setq s1 (ssget ":S" '((0 . "text"))))
)
(progn
(princ str1)
(setq ss (ssget '((0 . "text"))))
)
)
(progn
(setq e (ssname s1 0))
(ssdel e ss)
(setq num (GetTotle ss func)
n (distof (cdr (assoc 1 (entget e))))
)
(apply 'func1 (list n num))
)
)
)
(setq tf t)
(princ "\n计算方式[+ | - | * | / ]<+>: ")
(while tf
(setq key (grread)
code (car key)
val (cadr key)
)
(if (= code 2)
(cond
((or (= val 43) (= val 13)) ;_ +
(princ "\n选择相加数 ....")
(if (setq ss (ssget '((0 . "text"))))
(princ (GetTotle ss '+))
)
(setq tf nil)
)
((= val 42) ;_ *
(princ "\n选择相乘数....")
(if (setq ss (ssget '((0 . "text"))))
(princ (gettotle ss '*))
)
(setq tf nil)
)
((= val 95) ;_ /
(gettotle1 "\n拾取被减数..." "\n选择减数...." '+ '-)
(setq tf nil)
)
((= val 47) ;_ -
(gettotle1 "\n拾取被除数..." "\n选择除数...." '* '/)
(setq tf nil)
)
(t
(princ "\n**Invide Key!")
(princ "\n计算方式[+ | - | * | / ]<+>: ")
)
)
(setq tf nil)
)
)
(princ)
)

(defun c:tt (/ tf Gettotle1 GetTotle ss key code val) 
  (defun GetTotle (ss func) 
    (apply func 
           (mapcar '(lambda (x) 
                      (distof (cdr (assoc 1 (entget x)))) 
                    ) 
                   (acet-ss-to-list ss) 
           ) 
    ) 
  ) 
  (defun Gettotle1 (str str1 func func1 / e num n) 
    (if        (and (progn 
               (princ str) 
               (setq s1 (ssget ":S" '((0 . "text")))) 
             ) 
             (progn 
               (princ str1) 
               (setq ss (ssget '((0 . "text")))) 
             ) 
        ) 
      (progn 
        (setq e (ssname s1 0)) 
        (ssdel e ss) 
        (setq num (GetTotle ss func) 
              n          (distof (cdr (assoc 1 (entget e)))) 
        ) 
        (apply 'func1 (list n num)) 
      ) 
    ) 
  ) 
  (setq tf t) 
  (princ "\n计算方式[+ | - | * | / ]<+>: ") 
  (while tf 
    (setq key  (grread) 
          code (car key) 
          val  (cadr key) 
    ) 
    (if        (= code 2) 
      (cond 
        ((or (= val 43) (= val 13)) ;_ + 
         (princ "\n选择相加数 ....") 
         (if (setq ss (ssget '((0 . "text")))) 
           (princ (GetTotle ss '+)) 
         ) 
         (setq tf nil) 
        ) 
        ((= val 42) ;_ * 
         (princ "\n选择相乘数....") 
         (if (setq ss (ssget '((0 . "text")))) 
           (princ (gettotle ss '*)) 
         ) 
         (setq tf nil) 
        ) 
        ((= val 95) ;_ / 
         (gettotle1 "\n拾取被减数..." "\n选择减数...." '+ '-) 
         (setq tf nil) 
        ) 
        ((= val 47) ;_ - 
         (gettotle1 "\n拾取被除数..." "\n选择除数...." '* '/) 
         (setq tf nil) 
        ) 
        (t 
         (princ "\n**Invide Key!") 
         (princ "\n计算方式[+ | - | * | / ]<+>: ") 
        ) 
      ) 
      (setq tf nil) 
    ) 
  ) 
  (princ) 
)

zxq0220 · 发表于 2014-7-16 07:47:55

...
(if (setq ss1 (ssget '((0 . "TEXT"))))
(setq lst1 (mapcar 'cdr (mapcar '(lambda (a) (assoc 1 a)) (mapcar 'cadr (ssnamex ss1)))))
)
...

ll_j · 发表于 2014-7-16 08:49:24

推荐一下我的ce程序，可以在我的网络U盘下载。
一组和另一组进行运算，涉及的方面很多，诸如判别数据数量是否相等，选择集怎样排序，得到的结果按怎样的格式输出，等等等等，不是一两句话能说清的。
ce是早期的程序，有点乱，现在也没精力改了，如果有兴趣，可以也下载ca看看，这个程序近年改过，条理相对清楚，也涉及到一组和另一组运算，不妨看看。

77077 · 发表于 2014-7-16 20:08:50

zxq0220 发表于 2014-7-16 07:47

不错，要的就是这一句，刚开始我还打算用repeat呢。
三个mapcar~

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

[求助] 文本运算求助

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

点评