请教这个代码为什么无法选中数字？
(defun c:ee ( / apple_txt nl apple_nl apple_kkj apple_getstr apple_hb1 apple_hb0 apple_oldjd x y z apple_wz apple apple_wz1 zkh zkh1 apple_newjd obj qq nb nb1)
(vl-load-com)
(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)
)
本帖最后由 lxw320 于 2015-12-27 20:19 编辑
((0 . "*text")) *与text间不能有空格
(defun c:ee ( / apple_txt nl apple_nl apple_kkj apple_getstr apple_hb1 apple_hb0 apple_oldjd x y z apple_wz apple apple_wz1 zkh zkh1 apple_newjd obj qq nb nb1)
(vl-load-com)
(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输入字高:") 0 (rtos apple_jsjg 2 apple_newjd))
(princ)
) 多谢lxw320，我习惯性的在写完一个单词或者字符后敲一下空格，然后就悲剧了，这个代码我都检查好几遍了，还是有些没检查出来。
页:
[1]