明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 507|回复: 6

[提问] 求大神帮忙修改下程序,改成直接插入,而不用选1 2

[复制链接]
发表于 2018-8-28 11:11 | 显示全部楼层 |阅读模式
(DEFUN C:sum()
  (setvar "cmdecho" 0)
  (setq jd (getint "input 精度<0>:"))
  (if (= jd nil) (setq jd 3))
        (setq s (ssget '((1 . "*[0-9]*")))) ;选择含数字文本
  (setq k -1 mm 0.0 numdb '())
        (setq h2(cdr(assoc 40 (entget (ssname s 0)))))
  (repeat (sslength s)
      (setq a (entget (ssname s (setq k(1+ k)))))
      (setq tx (cdr (assoc '1 a)))
                  (setq b (StrType tx)k2 -1)
                (repeat (length b)
                        (setq txt2(nth (setq k2(1+ k2))b))
                        (if (numberp (read txt2))
      (setq mm (+ (atof txt2) mm) numdb (cons txt2 numdb)))
                )
  )
        (setq numdb(reverse numdb))
        (setq mm (strcat (strcat (car numdb) (apply 'strcat (mapcar '(lambda (x) (strcat "+" x)) (cdr numdb)))) "=" (rtos mm 2 jd)))
;  (setq mm (rtos mm 2 jd))  ;仅显示计算结果
  (initget "1 2")
  (setq fs(getkword "\n(1)新建文本 (2)覆盖文本<1>:"))
  (cond
          ((or(= fs "1")(= fs nil))
     (setq po (getpoint "\n指定计算结果的写入点:"))
                 (entmake (list '(0 . "TEXT") (cons 1 mm)(cons 8 "0")(cons 10 po)(cons 40 h2)(cons 62 7)))
          )
          ((= fs "2")
                  (while(/= (cdr(assoc 0 (setq en (entget(car (entsel "\n请选择要覆盖的文本: ")))))) "TEXT"))
                  (entmod (subst (cons 1 mm) (assoc 1 en) en))
          )
  )
  (setvar "cmdecho" 1)
        (princ)
)

(defun StrType(a / b c d e);;字符串分离全角、符号、字母、数字,存在问题:连续小数点与数字相连不能精确分离数字和小数点
  (setq b(vl-string->list a))
  (while b
    (setq a(car b)b(cdr b)c(last d))
    (if(or(not d)
               (and(< 0 a 32)(< 0 c 32));;非打印字符
               (or(= 46 a)(= 46 c)(and(< 47 a 58)(< 47 c 58)));数字和小数点
                           (vl-every'(lambda(x)(vl-some'(lambda(y)(<(car y)x(cadr y)))'((31 48)(57 65)(90 98)(122 129))))(list a c));其它字符包括小数点
               (vl-every'(lambda(x)(vl-some'(lambda(y)(<(car y)x(cadr y)))'((64 91)(96 123))))(list a c));;字母
             (and(> a 128)(> c 128)));;全角字符
       (if(> a 128)(setq d(vl-list*(car b)a d)b(cdr b))(setq d(cons a d)))
       (setq e(cons(reverse d)e)d(if(> a 128)(list(car b)a)(List a))b(if(> a 128)(cdr b)b))
                )
        )
  (mapcar'vl-list->string(reverse(cons(reverse d)e)))
)

发表于 2018-8-30 18:31 | 显示全部楼层
(defun c:sum ()
  (setvar "cmdecho" 0)
  (setq jd (getint "input 精度<0>:"))
  (if (= jd nil) (setq jd 0))
        (setq s (ssget '((1 . "*[0-9]*")))) ;选择含数字文本
  (setq k -1 mm 0.0 numdb '())
        (setq h2(cdr(assoc 40 (entget (ssname s 0)))))
  (repeat (sslength s)
      (setq a (entget (ssname s (setq k(1+ k)))))
      (setq tx (cdr (assoc '1 a)))
                  (setq b (StrType tx)k2 -1)
                (repeat (length b)
                        (setq txt2(nth (setq k2(1+ k2))b))
                        (if (numberp (read txt2))
      (setq mm (+ (atof txt2) mm) numdb (cons txt2 numdb)))
                )
  )
        (setq numdb(reverse numdb))
        (setq mm (strcat (strcat (car numdb) (apply 'strcat (mapcar '(lambda (x) (strcat "+" x)) (cdr numdb)))) "=" (rtos mm 2 jd)))

     (setq po (getpoint "\n指定计算结果的写入点:"))
                 (entmake (list '(0 . "TEXT") (cons 1 mm)(cons 8 "0")(cons 10 po)(cons 40 h2)(cons 62 7)))
         
  (setvar "cmdecho" 1)
        (princ)
)

(defun StrType(a / b c d e);;字符串分离全角、符号、字母、数字,存在问题:连续小数点与数字相连不能精确分离数字和小数点
  (setq b(vl-string->list a))
  (while b
    (setq a(car b)b(cdr b)c(last d))
    (if(or(not d)
               (and(< 0 a 32)(< 0 c 32));;非打印字符
               (or(= 46 a)(= 46 c)(and(< 47 a 58)(< 47 c 58)));数字和小数点
                           (vl-every'(lambda(x)(vl-some'(lambda(y)(<(car y)x(cadr y)))'((31 48)(57 65)(90 98)(122 129))))(list a c));其它字符包括小数点
               (vl-every'(lambda(x)(vl-some'(lambda(y)(<(car y)x(cadr y)))'((64 91)(96 123))))(list a c));;字母
             (and(> a 128)(> c 128)));;全角字符
       (if(> a 128)(setq d(vl-list*(car b)a d)b(cdr b))(setq d(cons a d)))
       (setq e(cons(reverse d)e)d(if(> a 128)(list(car b)a)(List a))b(if(> a 128)(cdr b)b))
                )
        )
  (mapcar'vl-list->string(reverse(cons(reverse d)e)))
)


原先的默认精度是3不是0,改过来了
发表于 2018-8-31 10:46 | 显示全部楼层
(defun c:tt( / var_bak jd ss n zg sum date txt sz zs sumstr sumlst m mlst mstr pt)
        (setq var_bak (getvar"OSMODE"))
        (setvar "OSMODE" 16384)
        (setq jd (getint "input 精度<0>:"))
  (if (= jd nil) (setq jd 3))
        (setq ss (ssget'((1 . "*[0-9]*"))))
        (setq n 0)
        (setq zg (cdr(assoc 40 (entget (ssname ss 0)))));获得字高
        (setq sum 0)
        (repeat (sslength ss)
                (setq date (entget(ssname ss n)))
                (setq txt (cdr (assoc 1 date)))
                (setq sz (hdsz txt))
          (setq sum (+ sz sum))
    (setq n (1+ n))
        )
        (setq sumstr (vl-princ-to-string sum))
        (setq sumlst (vl-string->list sumstr))
        (setq mlst (member 46 sumlst))  
        (if mlst
                (progn
                        (setq mstr (vl-list->string mlst))
                        (setq cz (- (length sumlst) (length mlst)))
                        (setq m (substr mstr 1 (+ jd 1)))
                        (setq zs (substr sumstr 1 cz))
      (setq sz (strcat zs m))
                )
                (setq sz (vl-princ-to-string sz))
        )
        (setq pt (getpoint"点击求和标注位置"))
        (if (= (tblobjname "layer" "SUM") nil) (command "._-layer"  "n" "SUM" ""))
        (entmake (list (cons 0 "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") (cons 8 "SUM") (cons 10 pt) (cons 40 zg) (cons 1 sz)))
)





(defun hdsz(txt / zfb a   )
        (setq zfb (vl-string->list txt))
        (foreach x zfb (setq a (mapcar'(lambda(x) (if (and (>= x 45) (<= x 58)) (setq a  x)(setq a nil))) zfb)))
        (foreach x a (setq a (vl-remove nil a)))
        (setq a (distof (vl-list->string a) 2))
)       
感觉他的好复杂,自己写了一个
 楼主| 发表于 2018-8-31 10:55 | 显示全部楼层
时见申 发表于 2018-8-31 10:46
(defun c:tt( / var_bak jd ss n zg sum date txt sz zs sumstr sumlst m mlst mstr pt)
        (setq var_bak ( ...

需要一个表达式,能否修改下,而不是直接放结果
 楼主| 发表于 2018-8-31 11:01 | 显示全部楼层
start4444 发表于 2018-8-30 18:31
(defun c:sum ()
  (setvar "cmdecho" 0)
  (setq jd (getint "input 精度:"))

你好能否修改一个乘法出结果的,如果可以的话吧除法和减法也高一下,谢谢大神
 楼主| 发表于 2018-8-31 11:07 | 显示全部楼层
start4444 发表于 2018-8-30 18:31
(defun c:sum ()
  (setvar "cmdecho" 0)
  (setq jd (getint "input 精度:"))

你好能否修改一个乘法出结果的,如果可以的话吧除法和减法也高一下,谢谢大神
发表于 2018-8-31 17:57 | 显示全部楼层
664571221 发表于 2018-8-31 11:07
你好能否修改一个乘法出结果的,如果可以的话吧除法和减法也高一下,谢谢大神

(defun c:tt5 ()

(setvar "cmdecho" 0)
  (setq jd (getint "input 精度<0>:"))
  (if (= jd nil) (setq jd 0))
        (setq s (ssget '((1 . "*[0-9]*")))) ;选择含数字文本
  (setq k -1 mm 1.0 numdb '())
        (setq h2(cdr(assoc 40 (entget (ssname s 0)))))
  (repeat (sslength s)
      (setq a (entget (ssname s (setq k(1+ k)))))
      (setq tx (cdr (assoc '1 a)))
                  (setq b (StrType tx)k2 -1)
                (repeat (length b)
                        (setq txt2(nth (setq k2(1+ k2))b))
                        (if (numberp (read txt2))
      (setq mm (* (atof txt2) mm) numdb (cons txt2 numdb)))
                )
  )
        (setq numdb(reverse numdb))
        (setq mm (strcat (strcat (car numdb) (apply 'strcat (mapcar '(lambda (x) (strcat "*" x)) (cdr numdb)))) "=" (rtos mm 2 jd)))

     (setq po (getpoint "\n指定计算结果的写入点:"))
                 (entmake (list '(0 . "TEXT") (cons 1 mm)(cons 8 "0")(cons 10 po)(cons 40 h2)(cons 62 7)))
         
  (setvar "cmdecho" 1)
        (princ)
)

(defun StrType(a / b c d e);;字符串分离全角、符号、字母、数字,存在问题:连续小数点与数字相连不能精确分离数字和小数点
  (setq b(vl-string->list a))
  (while b
    (setq a(car b)b(cdr b)c(last d))
    (if(or(not d)
               (and(< 0 a 32)(< 0 c 32));;非打印字符
               (or(= 46 a)(= 46 c)(and(< 47 a 58)(< 47 c 58)));数字和小数点
                           (vl-every'(lambda(x)(vl-some'(lambda(y)(<(car y)x(cadr y)))'((31 48)(57 65)(90 98)(122 129))))(list a c));其它字符包括小数点
               (vl-every'(lambda(x)(vl-some'(lambda(y)(<(car y)x(cadr y)))'((64 91)(96 123))))(list a c));;字母
             (and(> a 128)(> c 128)));;全角字符
       (if(> a 128)(setq d(vl-list*(car b)a d)b(cdr b))(setq d(cons a d)))
       (setq e(cons(reverse d)e)d(if(> a 128)(list(car b)a)(List a))b(if(> a 128)(cdr b)b))
                )
        )
  (mapcar'vl-list->string(reverse(cons(reverse d)e)))
)


这个是乘法的,没有详细测试你自己看吧,减法和除法涉及顺序问题,水平有限等其他大神吧
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-4-16 22:38 , Processed in 0.307446 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表