求帮忙改下求和lsp，求和结果覆盖选择的文本

lixwkkk

这个lsp挺好用，定义精度，求和，写文本到CAD，但是我想要的是最后一步提示选择文本，然后把求和结果覆盖过去，哪位帮忙改下呢。
(DEFUN C:KK()
(setq jd (getint "input 精度<0>:"))
(if (= jd nil) (setq jd 0))
(princ "\nselect object:")
(setq s (ssget))
(setq n (sslength s))
(setq k 0 )(setq mm 0.0)
(while (< k n)
      (setq name (ssname s k))
      (setq a (entget name))
      (setq t1 (assoc '0 a))
      (setq t1 (cdr t1))
      (if (= t1 "TEXT") (PROGN
          (setq tx (assoc '1 a))
          (setq tx (cdr tx))
          (setq tx (atof tx))
          (setq mm (+ tx mm))
         ))
      (if (= t1 "DIMENSION") (PROGN
          (setq tx (assoc '1 a))
          (setq tx (cdr tx))
          (if (and (/= tx "")(/= tx "<>"))(setq tx (atof tx)))
          (if (or (= tx "")(= tx "<>"))(progn
              (setq tx (assoc '42 a))
              (setq tx (cdr tx))
              ))
          (if (= k 0) (setq MM TX) (setq mm (+ tx mm)))
         ))
      (setq k (+ k 1))
)
(setq mm (rtos mm 2 jd))
(setq po (getpoint "\n指定计算结果的写入点:"))
(command "text" po ""  "" mm)
)

ll_j

到我的网络U盘（看签名）去下载一个Ce.lsp，功能比你想要的多。

尘缘一生

【三领外挂】采用的，提供出来

1. ;;-------求和并写出-----------------------------------------------------------
   
2. (defun c:qiuhe(/ e e1 p n l l1 d pt0 pt2 pt3 ang hi)
   
3.   (command)
   
4.   (SSET)
   
5.   (setvar "LUPREC" 2);;;;精度到小数点后2位
   
6.   (setq pt0 0)
   
7.   (setq e(ssget))
   
8.   (setq p (sslength e))
   
9.   (setq n 0)
   
10.   (setq p (- p 1))
    
11.   (while (<= n p)
    
12.     (setq e1(entget(ssname e n)))
    
13.     (if (="TEXT" (cdr(assoc 0 e1)))
    
14.       (progn
    
15.         (setq pt2(atof(cdr(assoc 1 e1))))
    
16.         (setq pt0(+ pt0 pt2))
    
17.       )
    
18.     )
    
19.     (setq n(+ n 1))
    
20.   )  
    
21.   (alert(setq pt0 (rtos pt0))) ;;;;;把和数字变为字符串,并显示出来
    
22.   (setq l(strlen pt0))      
    
23.   (while (="0" (substr pt0 l))
    
24.     (setq pt0 (substr pt0 1 (- l 1)))
    
25.     (setq l(strlen pt0))
    
26.   )
    
27.   (if (="." (substr pt0 l))
    
28.     (setq pt0 (substr pt0 1 (- l 1)))
    
29.     (setq l(strlen pt0))
    
30.   )  
    
31.   (CHZI)
    
32.   (SSET1)
    
33. )
    
34. 
    
35. 
    
36. ;;----------------------------------------------------------------------------
    
37. 
    
38. (defun SSET( )
    
39.   (setq oldos (getvar "OSMODE"))
    
40.   (setq oldorh (getvar "ORTHOMODE"))
    
41.   (setq oldsn (getvar "SNAPMODE"))
    
42.   (setq oldlup (getvar "LUPREC"))
    
43.   (setvar "OSMODE" 0) ;;;捕捉关闭
    
44.   (setvar "ORTHOMODE" 0) ;;;正交关闭
    
45.   (setvar "SNAPMODE" 0);;;;实体捕捉关闭
    
46.   (setvar "CMDECHO" 0)
    
47.   (setvar "TEXTEVAL" 1)
    
48. )
    
49. 
    
50. ;;---------------------------------------------------------------------------
    
51. (defun SSET1( )
    
52.   (setvar "ORTHOMODE" oldorh)  ;;;恢复正交
    
53.   (setvar "OSMODE" oldos)  ;;;恢复正交
    
54.   (setvar "SNAPMODE" oldsn) ;;;;恢复实体捕捉  
    
55.   (setvar "LUPREC" oldlup)  ;;;;恢复数值小数位数
    
56.   (setvar "CMDECHO" 1)
    
57. )
    
58. 
    
59. ;;------根据给出的字符串pt0改-写字符----------------------------------------------------
    
60. (defun CHZI ( )
    
61.   (setq oldlup (getvar "LUPREC"))
    
62.   (setvar "LUPREC" 0);;;;精度到各位,以便后续取得标准颜色号
    
63.   (princ "\n 选择修改数字，空选(右键）即写出: ")
    
64.   (setq e1(ssget))
    
65.   (if (/= e1 nil)  
    
66.     (progn  
    
67.       (setq p (sslength e1))
    
68.       (setq n 0)
    
69.       (setq p (- p 1))
    
70.       (while (<= n p)  
    
71.         (setq e(entget(ssname e1 n)))         
    
72.         (if (OR (="TEXT" (cdr(assoc 0 e)))(="MTEXT" (cdr(assoc 0 e))))
    
73.           (progn
    
74.             (setq ang(angtos (cdr(assoc 50 e)) 0 2))
    
75.             (setq hi(cdr(assoc 40 e)))
    
76.             (setq sty(cdr(assoc 7 e)))        
    
77.             (setq pt1(cdr(assoc 10 e)))
    
78.             (entdel(ssname e1 n))
    
79.             (command "TEXT" "S" sty pt1 hi ang pt0)
    
80.             (vl-cmdf "_.JustifyText" (entlast) "" "ML")
    
81.             (command "CHANGE" (entlast) "" "P" "C" (rtos (1+ (rem (getvar "CPUTICKS") 8))) "")                  
    
82.           );;;;progn
    
83.         )  ;;;; end if
    
84.         (setq n (+ n 1))
    
85.       );;;;while
    
86.     );;;progn
    
87.   )
    
88.   (if (= e1 nil)
    
89.     (progn   
    
90.       (setq pt3 (nth 1 (grread 5)))  ;取得文字写入点     
    
91.       (command "TEXT" pt3 (* (getvar "DIMSCALE") 3.0) 0 pt0)  
    
92.       (vl-cmdf "_.JustifyText" (entlast) "" "ML")
    
93.       (command "MOVE" (entlast) "" pt3 pause"")
    
94.       (command "CHANGE" (entlast) "" "P" "C" (rtos (1+ (rem (getvar "CPUTICKS") 8))) "")
    
95.     )                                  ; progn
    
96.   )
    
97.   (setvar "LUPREC" oldlup)  ;;;;恢复数值小数位数
    
98. )
    
99. 
    
100. ;;-----------------------------------------------------------------------------------

;;-------求和并写出-----------------------------------------------------------<br /> (defun c:qiuhe(/ e e1 p n l l1 d pt0 pt2 pt3 ang hi)<br />   (command)<br />   (SSET)<br />   (setvar "LUPREC" 2);;;;精度到小数点后2位<br />   (setq pt0 0)<br />   (setq e(ssget))<br />   (setq p (sslength e))<br />   (setq n 0)<br />   (setq p (- p 1))<br />   (while (<= n p)<br />     (setq e1(entget(ssname e n)))<br />     (if (="TEXT" (cdr(assoc 0 e1)))<br />       (progn<br />         (setq pt2(atof(cdr(assoc 1 e1))))<br />         (setq pt0(+ pt0 pt2))<br />       )<br />     )<br />     (setq n(+ n 1))<br />   )  <br />   (alert(setq pt0 (rtos pt0))) ;;;;;把和数字变为字符串,并显示出来<br />   (setq l(strlen pt0))      <br />   (while (="0" (substr pt0 l))<br />     (setq pt0 (substr pt0 1 (- l 1)))<br />     (setq l(strlen pt0))<br />   )<br />   (if (="." (substr pt0 l))<br />     (setq pt0 (substr pt0 1 (- l 1)))<br />     (setq l(strlen pt0))<br />   )  <br />   (CHZI)<br />   (SSET1)<br /> )<br /> <br /> <br /> ;;----------------------------------------------------------------------------<br /> <br /> (defun SSET( )<br />   (setq oldos (getvar "OSMODE"))<br />   (setq oldorh (getvar "ORTHOMODE"))<br />   (setq oldsn (getvar "SNAPMODE"))<br />   (setq oldlup (getvar "LUPREC"))<br />   (setvar "OSMODE" 0) ;;;捕捉关闭<br />   (setvar "ORTHOMODE" 0) ;;;正交关闭<br />   (setvar "SNAPMODE" 0);;;;实体捕捉关闭<br />   (setvar "CMDECHO" 0)<br />   (setvar "TEXTEVAL" 1)<br /> )<br /> <br /> ;;---------------------------------------------------------------------------<br /> (defun SSET1( )<br />   (setvar "ORTHOMODE" oldorh)  ;;;恢复正交<br />   (setvar "OSMODE" oldos)  ;;;恢复正交<br />   (setvar "SNAPMODE" oldsn) ;;;;恢复实体捕捉  <br />   (setvar "LUPREC" oldlup)  ;;;;恢复数值小数位数<br />   (setvar "CMDECHO" 1)<br /> )<br /> <br /> ;;------根据给出的字符串pt0改-写字符----------------------------------------------------<br /> (defun CHZI ( )<br />   (setq oldlup (getvar "LUPREC"))<br />   (setvar "LUPREC" 0);;;;精度到各位,以便后续取得标准颜色号<br />   (princ "\n 选择修改数字，空选(右键）即写出: ")<br />   (setq e1(ssget))<br />   (if (/= e1 nil)  <br />     (progn  <br />       (setq p (sslength e1))<br />       (setq n 0)<br />       (setq p (- p 1))<br />       (while (<= n p)  <br />         (setq e(entget(ssname e1 n)))          <br />         (if (OR (="TEXT" (cdr(assoc 0 e)))(="MTEXT" (cdr(assoc 0 e))))<br />           (progn<br />             (setq ang(angtos (cdr(assoc 50 e)) 0 2))<br />             (setq hi(cdr(assoc 40 e)))<br />             (setq sty(cdr(assoc 7 e)))        <br />             (setq pt1(cdr(assoc 10 e)))<br />             (entdel(ssname e1 n))<br />             (command "TEXT" "S" sty pt1 hi ang pt0)<br />             (vl-cmdf "_.JustifyText" (entlast) "" "ML")<br />             (command "CHANGE" (entlast) "" "P" "C" (rtos (1+ (rem (getvar "CPUTICKS") 8))) "")                  <br />           );;;;progn<br />         )  ;;;; end if<br />         (setq n (+ n 1))<br />       );;;;while<br />     );;;progn<br />   )<br />   (if (= e1 nil)<br />     (progn   <br />       (setq pt3 (nth 1 (grread 5)))  ;取得文字写入点     <br />       (command "TEXT" pt3 (* (getvar "DIMSCALE") 3.0) 0 pt0)  <br />       (vl-cmdf "_.JustifyText" (entlast) "" "ML")<br />       (command "MOVE" (entlast) "" pt3 pause"")<br />       (command "CHANGE" (entlast) "" "P" "C" (rtos (1+ (rem (getvar "CPUTICKS") 8))) "")<br />     )                                  ; progn<br />   )<br />   (setvar "LUPREC" oldlup)  ;;;;恢复数值小数位数<br /> )<br /> <br /> ;;-----------------------------------------------------------------------------------

lixwkkk

ll_j 发表于 2018-7-5 17:33
到我的网络U盘（看签名）去下载一个Ce.lsp，功能比你想要的多。

谢谢前辈，您的lsp里最后一步没有我要的功能，就是计算结果覆盖指定文本，其他的运算，常青藤软件的求和都能实现的。

lixwkkk

尘缘一生 发表于 2018-7-5 18:27
【三领外挂】采用的，提供出来

多谢！最后一步有数据覆盖指定文本了，但是能否删除一部分啊，不想要弹窗提示，覆盖的数据会变颜色，这个功能可以去掉吗，然后还缺个精度指定参数。。。。。我只想要个简单的求和加覆盖指定文件

lifuq1979

(DEFUN C:KK()
(setvar "cmdecho" 0)
(setq jd (getint "input 精度<0>:"))
(if (= jd nil) (setq jd 0))
(princ "\nselect object:")
(setq s (ssget))
(setq n (sslength s))
(setq k 0 )(setq mm 0.0)
(while (< k n)
      (setq name (ssname s k))
      (setq a (entget name))
      (setq t1 (assoc '0 a))
      (setq t1 (cdr t1))
      (if (= t1 "TEXT") (PROGN
          (setq tx (assoc '1 a))
          (setq tx (cdr tx))
          (setq tx (atof tx))
          (setq mm (+ tx mm))
         ))
      (if (= t1 "DIMENSION") (PROGN
          (setq tx (assoc '1 a))
          (setq tx (cdr tx))
          (if (and (/= tx "")(/= tx "<>"))(setq tx (atof tx)))
          (if (or (= tx "")(= tx "<>"))(progn
              (setq tx (assoc '42 a))
              (setq tx (cdr tx))
              ))
          (if (= k 0) (setq MM TX) (setq mm (+ tx mm)))
         ))
      (setq k (+ k 1))
)
(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指定计算结果的写入点:"))
   (command "text" po ""  "" mm)
        )
        ((= 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)
)

lifuq1979

希望可以帮到你，最好把(setq s (ssget))改成
(setq s (ssget '((0 . "TEXT") (1 . "~*[~`--9]*"))))选取纯数字文本

lifuq1979

(DEFUN C:KK()
(setvar "cmdecho" 0)
(setq jd (getint "input 精度<0>:"))
(if (= jd nil) (setq jd 0))
(princ "\nselect object:")
;(setq s (ssget))
(setq s (ssget '((0 . "TEXT") (1 . "~*[~`--9]*"))))
(setq n (sslength s))
(setq k 0 )(setq mm 0.0)
(while (< k n)
      (setq name (ssname s k))
      (setq a (entget name))
      (setq t1 (assoc '0 a))
      (setq t1 (cdr t1))
      (if (= t1 "TEXT") (PROGN
          (setq tx (assoc '1 a))
          (setq tx (cdr tx))
          (setq tx (atof tx))
          (setq mm (+ tx mm))
         ))
      (if (= t1 "DIMENSION") (PROGN
          (setq tx (assoc '1 a))
          (setq tx (cdr tx))
          (if (and (/= tx "")(/= tx "<>"))(setq tx (atof tx)))
          (if (or (= tx "")(= tx "<>"))(progn
              (setq tx (assoc '42 a))
              (setq tx (cdr tx))
              ))
          (if (= k 0) (setq MM TX) (setq mm (+ tx mm)))
         ))
      (setq k (+ k 1))
)
(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指定计算结果的写入点:"))
   (command "text" po ""  "" mm)
        )
        ((= 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)
)

lifuq1979

希望可以帮到你

lifuq1979

简化了一下
(DEFUN C:KK()
  (setvar "cmdecho" 0)
  (setq jd (getint "input 精度<0>:"))
  (if (= jd nil) (setq jd 0))
  (setq s (ssget '((0 . "TEXT") (1 . "~*[~`--9]*"))))
  (setq k -1 mm 0.0)
  (repeat (sslength s)
      (setq a (entget (ssname s (setq k(1+ k)))))
      (setq tx (cdr (assoc '1 a)))
      (setq tx (atof tx))
      (setq mm (+ tx mm))
  )
  (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指定计算结果的写入点:"))
     (command "text" po ""  "" mm)
          )
          ((= 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)
)