[LISP程序]：求文字中包含的数字的和

snsj · 发表于 2003-8-22 15:26:51

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

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

×

;;;求所选文字中包含的数字和
;;;应用范围:支持MTEXT/TEXT
;;;有效性:只对每个字段里包含一个数字的字段有效
;;;支持文字中非小数点的点存在
;;;制作:SNSJ
;;;nbs.lsp
(defun c:nbs (/ apple_ss apple_sl js apple_nil apple_getpt apple_ssn apple_nss apple_txtsz
apple_nmss apple_nmbss apple_strl apple_sub apple_getn apple_nbs)
(setq apple_ss (ssget'((-4 . "< OR") (0 . "text") (0 . "mtext") (-4 . "OR >")))
)
(cond
((null apple_ss)(princ"\n###---选择的字体为空---#")
(exit))
)
(setq
apple_sl (sslength apple_ss)
js 0
apple_nil '()
)
(setq apple_getpt (getpoint "\n$选择插入计算结果的点$:")
)
(if (null apple_oldnb)
(setq apple_oldnb 100)
)
(initget (+ 2 4))
(setq apple_txtsz (getreal(strcat "\n&输入文字高度(" (rtos apple_oldnb) ")&:")
)
)
(if (null apple_txtsz)
(setq apple_txtsz apple_oldnb)
(setq apple_oldnb apple_txtsz)
)
(cond
((null apple_getpt)(princ"\n###---函数被取消---###")
(exit)
)
)
(repeat apple_sl
(setq apple_ssn (ssname apple_ss js)
apple_nil (cons apple_ssn apple_nil)
)
(setq js (+ js 1))
)
(setq apple_nss (reverse apple_nil))
(setq apple_nmss
(mapcar
'(lambda (x)
(vla-get-textstring(vlax-ename->vla-object x)
)
)
apple_nss
)
)
(setq apple_nmbss
(mapcar
'(lambda (y)
(setq apple_strl (strlen y)
i 1
c '())
(repeat apple_strl
(setq apple_sub (substr y i 1))
(if (or(and(<= (ascii apple_sub) 57) (>= (ascii apple_sub) 48)
)
(= (ascii apple_sub) 46)
)
(setq c (cons apple_sub c))
)
(setq i (+ i 1))
)
(setq c (reverse c))
(setq apple_nbs (apply 'strcat c)
)
(setq apple_nbs (vl-string-left-trim "." apple_nbs))
(setq apple_getn (vl-string-right-trim "." apple_nbs))
(atof apple_getn)
)
apple_nmss
)
)
(setq apple_nbs (vl-princ-to-string(apply '+ apple_nmbss)
)
)
(command ".text" apple_getpt apple_txtsz "" apple_nbs)
(princ"\n###---所选数的和为：")
(princ apple_nbs)
(princ "---###")
(princ)
)

;;;求所选文字中包含的数字和 
;;;应用范围:支持MTEXT/TEXT 
;;;有效性:只对每个字段里包含一个数字的字段有效 
;;;支持文字中非小数点的点存在 
;;;制作:SNSJ 
;;;nbs.lsp 
(defun c:nbs (/ apple_ss apple_sl js apple_nil apple_getpt apple_ssn apple_nss apple_txtsz 
                apple_nmss apple_nmbss apple_strl apple_sub apple_getn apple_nbs) 
(setq apple_ss (ssget'((-4 . "< OR") (0 . "text") (0 . "mtext") (-4 . "OR >")))       
      ) 
  (cond 
    ((null apple_ss)(princ"\n###---选择的字体为空---#") 
     (exit)) 
    ) 
      (setq 
      apple_sl (sslength apple_ss) 
      js 0 
      apple_nil '() 
      ) 
  (setq apple_getpt (getpoint "\n$选择插入计算结果的点$:") 
        ) 
    (if (null apple_oldnb) 
    (setq apple_oldnb 100) 
    ) 
  (initget (+ 2 4)) 
  (setq apple_txtsz (getreal(strcat "\n&输入文字高度(" (rtos apple_oldnb) ")&:") 
                            ) 
        ) 
  (if (null apple_txtsz) 
    (setq apple_txtsz  apple_oldnb)    
     (setq apple_oldnb  apple_txtsz)      
      ) 
        (cond 
          ((null apple_getpt)(princ"\n###---函数被取消---###") 
           (exit) 
           ) 
          )    
(repeat apple_sl 
  (setq apple_ssn (ssname apple_ss js) 
        apple_nil (cons apple_ssn apple_nil) 
        ) 
  (setq js (+ js 1)) 
  ) 
(setq apple_nss (reverse apple_nil)) 
(setq apple_nmss 
(mapcar 
  '(lambda (x) 
     (vla-get-textstring(vlax-ename->vla-object x) 
       ) 
     ) 
  apple_nss 
  ) 
      ) 
(setq apple_nmbss 
(mapcar 
  '(lambda (y)       
(setq apple_strl (strlen y) 
      i 1 
      c '()) 
(repeat apple_strl   
  (setq apple_sub (substr y i 1))   
   
  (if (or(and(<= (ascii apple_sub) 57) (>= (ascii apple_sub) 48) 
              ) 
         (= (ascii apple_sub) 46) 
             ) 
    (setq c (cons apple_sub c))    
    ) 
  (setq i (+ i 1)) 
  ) 
(setq c (reverse c)) 
(setq apple_nbs (apply 'strcat c) 
      ) 
(setq apple_nbs (vl-string-left-trim "." apple_nbs)) 
(setq apple_getn (vl-string-right-trim "." apple_nbs))   
          (atof apple_getn) 
          )    
  apple_nmss 
  ) 
) 
(setq apple_nbs (vl-princ-to-string(apply '+ apple_nmbss) 
                     ) 
      ) 
  (command ".text" apple_getpt apple_txtsz "" apple_nbs) 
  (princ"\n###---所选数的和为：") 
  (princ apple_nbs) 
  (princ "---###") 
  (princ) 
  )

下载地址：http://www.xdcad.net/modrator/fi ... 0822152903_wzjs.swf

<embed src=http://www.xdcad.net/modrator/file_upload/4508/20030822152903_wzjs.swf quality=high width=400 height=300 loop=true type="application/x-shockwave-flash">
</embed>

雷鸟 · 发表于 2004-1-4 01:18:34

好，我用了，谢谢

陌生人 · 发表于 2004-1-4 20:13:17

拷贝使用时，(ssget'((-4 . "《OR") (0 . "text") (0 . "mtext") (-4 . "OR》")))
"《OR" "OR》" 应改为半角. 另外也可改写为： (ssget '((0 . "*TEXT")))
程序还可简化

snsj · 发表于 2004-1-4 21:31:44

谢谢指点，半角和全角的问题是为了显示完全，否则无法显示出代码，(ssget '((0 . "*TEXT")))提的好谢谢

陌生人 · 发表于 2004-1-4 21:55:22

不客气，看看我的另外一贴。也是写文本求和的。支持选择集文本中多个数字。
http://www.xdcad.net/forum/showt ... amp;threadid=134245

cynthia · 发表于 2004-1-15 00:48:06

snsj 斑竹，我基本不懂lisp，请不要见笑。在使用你的程序时出现下面的问题，该如何解决？请指点，谢谢。
Command: nbs
Select objects: Specify opposite corner: 2 found
Select objects: 1 found, 3 total
Select objects:
$选择插入计算结果的点$:
&输入文字高度(100)&:
; error: no function definition: VLAX-ENAME->VLA-OBJECT

snsj · 发表于 2004-1-17 03:37:05

上面的没加(vl-load-all)
下面的是最修版本，基本上解决了所有多行文本出现的问题

;;;--------------------求所选文字中包含的数字和---------------------;;;
;;;---------------------应用范围:支持MTEXT/TEXT---------------------;;;
;;;--------------有效性:对每个字段里包含多个数字的字段有效----------;;;
;;;-----支持负数、非小数点的其他点存在，支持多行文本中不同字体------;;;
;;;----------------本程序可自由使用，转载请注明出处-----------------;;;
;;;--------------------------制作:SNSJ 2004.1.15--------------------;;;
;;;---------------------------nbs.lsp-------------------------------;;;
(defun c:nbs(/ apple_txt nl apple_nl apple_kkj apple_getstr apple_hb1
apple_hb0 apple_nl x y z apple_wz apple_wz1 zkh zkh1
apple_newjd obj qq nb nb1)
(vl-load-com)
(princ "\n***&对选中文字求和程序&制作:SNSJ***")
(setq apple_txt nil nl nil apple_nl nil apple_kkj nil apple_getstr nil)
(if (ssget '((0 . "* TEXT")))
(vlax-for obj (vla-get-activeselectionset
(vla-get-activedocument (vlax-get-acad-object)))
(setq apple_txt (cons(strcat(vla-get-textstring obj) "*")apple_txt))
)
)
(setq apple_hb (vl-catch-all-apply 'strcat apple_txt))
(while (vl-string-search "\\P" apple_hb)
(setq apple_hb (vl-string-subst "*" "\\P" apple_hb))
)
(setq apple_hb0 apple_hb)
(while
(setq nb (vl-string-search "{" apple_ hb)
nb1 (vl-string-search "}" apple_hb))
(setq nl (cons (substr apple _hb (+ nb 1) (- nb1 (- nb 1))) nl))
(setq apple_hb (substr apple_hb (+ nb1 2)))
)
(setq apple_hb1 (vl-catch-all-apply 'strcat nl))
(mapcar
'(lambda (x)
(setq apple_hb0 (vl-string-subst " " x apple_hb0))
) nl
)
(while
(setq apple_wz (vl-string-search ";" apple_hb1))
(setq apple_hb1 (substr apple_hb1 (+ apple_wz 2)))
(setq zkh (vl-string-search "}" apple_hb1))
(setq zkh1 (vl-string-search "\" apple_hb1)
)
(cond
((null zkh1)(setq qq zkh))
(t (setq qq (min zkh zkh1)))
)
(setq apple_nl (cons (substr apple_hb1 1 (+ qq 1)) apple_nl))
(setq apple_hb1 (substr apple_hb1 (+ qq 2)))
)
(setq apple_nl (cons apple_hb0 apple_ nl))
(setq apple_nl (vl-catch-all-apply 'strcat apple_nl))
(mapcar '(lambda (y)
(if (not(or(and(<= y 57) (>= y 48)) (= y 46) (= y 45)))
(setq y 32))
(setq apple_kkj (cons y apple_kkj)))
(vl-string->list apple_nl)
)
(setq apple_ kkj (vl-string-trim " " (vl-list->string (reverse apple_kkj))))
(while
(setq apple_wz1 (vl-string-search " " apple_kkj))
(setq apple_getstr (cons (substr apple_kkj 1 apple_wz1) apple_getstr))
(setq apple_kkj (vl-string-trim " "(substr apple_kkj (+ apple_wz1 2))))
)
(setq apple_ getstr
(mapcar
'(lambda (z)
(atof z)
)
(vl-remove "." (vl-remove "-"(cons apple_kkj apple_getstr))))
)
(setq apple_jsjg (vl-catch-all-apply '+ apple_getstr))
(princ "\n&所选文字中数字的和为&:")
(princ apple_jsjg)
(cond ((null apple_oldjd) (setq apple_oldjd 2)))
(initget 4)
(setq apple_ newjd (getint(strcat "\n&输入计算精度&<" (rtos apple_oldjd) ">")))
(if (not apple_newjd)
(setq apple_ newjd apple_ oldjd)(setq apple_oldjd apple_newjd)
)
(vl-cmdf ".text" (getpoint "\n&计算结果插入点&:")(getdist "\n&输入字高&:") "" (rtos apple _jsjg 2 apple_newjd))
(princ)
)

;;;--------------------求所选文字中包含的数字和---------------------;;; 
;;;---------------------应用范围:支持MTEXT/TEXT---------------------;;; 
;;;--------------有效性:对每个字段里包含多个数字的字段有效----------;;; 
;;;-----支持负数、非小数点的其他点存在，支持多行文本中不同字体------;;; 
;;;----------------本程序可自由使用，转载请注明出处-----------------;;; 
;;;--------------------------制作:SNSJ 2004.1.15--------------------;;; 
;;;---------------------------nbs.lsp-------------------------------;;; 
(defun c:nbs(/ apple_txt nl apple_nl apple_kkj apple_getstr apple_hb1 
               apple_hb0 apple_nl x y z apple_wz apple_wz1 zkh zkh1 
               apple_newjd obj qq nb nb1) 
 (vl-load-com) 
  (princ "\n***&对选中文字求和程序&制作:SNSJ***") 
(setq apple_txt nil nl nil apple_nl nil apple_kkj nil apple_getstr nil) 
(if (ssget '((0 . "* TEXT"))) 
    (vlax-for obj (vla-get-activeselectionset 
                    (vla-get-activedocument (vlax-get-acad-object))) 
      (setq apple_txt (cons(strcat(vla-get-textstring obj) "*")apple_txt)) 
            ) 
      ) 
(setq apple_hb (vl-catch-all-apply 'strcat apple_txt)) 
  (while  (vl-string-search "\\P" apple_hb) 
(setq apple_hb (vl-string-subst "*" "\\P"  apple_hb)) 
) 
(setq apple_hb0 apple_hb) 
(while 
  (setq nb (vl-string-search "{" apple_ hb) 
        nb1 (vl-string-search "}" apple_hb)) 
  (setq nl (cons (substr apple _hb (+ nb 1) (- nb1 (- nb 1))) nl)) 
  (setq apple_hb (substr apple_hb (+ nb1 2))) 
  ) 
(setq apple_hb1 (vl-catch-all-apply 'strcat nl)) 
(mapcar 
  '(lambda (x) 
    (setq apple_hb0 (vl-string-subst  " " x apple_hb0)) 
     )  nl 
  ) 
(while 
   (setq apple_wz (vl-string-search  ";" apple_hb1)) 
   (setq apple_hb1 (substr apple_hb1 (+ apple_wz 2))) 
   (setq zkh (vl-string-search "}" apple_hb1)) 
   (setq zkh1 (vl-string-search "\" apple_hb1) 
         ) 
  (cond 
    ((null zkh1)(setq qq zkh)) 
    (t (setq qq (min zkh zkh1))) 
    ) 
  (setq apple_nl (cons (substr apple_hb1 1 (+ qq 1)) apple_nl)) 
        (setq apple_hb1 (substr apple_hb1 (+ qq 2))) 
       ) 
(setq apple_nl (cons apple_hb0 apple_ nl)) 
(setq apple_nl (vl-catch-all-apply 'strcat apple_nl)) 
(mapcar '(lambda (y) 
          (if (not(or(and(<= y 57) (>= y 48)) (= y 46) (= y 45))) 
            (setq y 32)) 
           (setq apple_kkj (cons y apple_kkj))) 
        (vl-string->list apple_nl) 
        ) 
(setq apple_ kkj (vl-string-trim " " (vl-list->string (reverse  apple_kkj)))) 
 (while       
    (setq apple_wz1 (vl-string-search " " apple_kkj)) 
   (setq apple_getstr (cons (substr  apple_kkj 1  apple_wz1) apple_getstr)) 
(setq apple_kkj (vl-string-trim " "(substr apple_kkj (+ apple_wz1 2)))) 
   ) 
(setq apple_ getstr 
  (mapcar 
  '(lambda (z) 
     (atof z) 
           ) 
     (vl-remove "." (vl-remove "-"(cons apple_kkj apple_getstr)))) 
     ) 
  (setq apple_jsjg (vl-catch-all-apply '+ apple_getstr)) 
  (princ "\n&所选文字中数字的和为&:") 
  (princ apple_jsjg) 
(cond ((null apple_oldjd) (setq apple_oldjd 2))) 
   (initget 4) 
      (setq apple_ newjd (getint(strcat "\n&输入计算精度&<" (rtos apple_oldjd) ">"))) 
      (if (not apple_newjd) 
        (setq apple_ newjd apple_ oldjd)(setq apple_oldjd apple_newjd) 
        ) 
(vl-cmdf ".text" (getpoint "\n&计算结果插入点&:")(getdist "\n&输入字高&:") "" (rtos apple _jsjg 2 apple_newjd)) 
(princ) 
  )

夜精灵 · 发表于 2006-6-15 11:17:12

好用谢谢

草根 · 发表于 2006-6-15 11:59:39

最初由陌生人发布
[B]不客气，看看我的另外一贴。也是写文本求和的。支持选择集文本中多个数字。
http://www.xdcad.net/forum/showt ... amp;threadid=134245 [/B]

您的程序好使、简练，比楼主的好，就是提问过多，可以按图中数字的文字大小，数字精度确认。

coolboyman · 发表于 2006-11-16 09:56:34

我也遇到6楼的问题，有没有高手解决一下？

snsj · 发表于 2006-11-16 11:24:26

只实用与2000以上版本

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

[LISP程序]：求文字中包含的数字的和

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

相关帖子