[分享]：给选定的一组数字统一加上或减去一个数值

lsy · 发表于 2003-1-5 14:18:47

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

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

×

[font=courier new]
(defun C:NUM ()
(setq ss1 (ssget)
len1 (sslength ss1)
cnt 0
add (getreal "\nEnter number to add to elevations: ")
)
(while (< cnt len1)
(setq dent (entget (ssname ss1 cnt))
txt (cdr (assoc 1 dent))
len (strlen txt)
cnt1 1
)
(while (<= cnt1 len)
(if (/= (substr txt cnt1 1) " ")
(progn
(setq num (atof (substr txt cnt1 len))
numlen (strlen (rtos num 2 5)))
(if (/= num 0)
(progn
(cond ((= (substr txt cnt1 numlen) (rtos num 2 5)) (setq sp 0))
((= (substr txt cnt1 (- numlen 1)) (rtos num 2 1)) (setq sp 1))
((= (substr txt cnt1 (- numlen 3)) (rtos num 2 0)) (setq sp 3))
);cond
(setq rtxt (substr txt (- (+ cnt1 numlen) sp) len)
num (+ add num)
numt (rtos num 2 5)
ntx (strcat (substr txt 1 (- cnt1 1)) numt rtxt)
old (assoc 1 dent)
new (cons 1 ntx)
dent (subst new old dent)
cnt1 (+ 1 len)
);setq
(entmod dent)
);progn
)));if,progn,if
(setq cnt1 (1+ cnt1))
);end while
(setq cnt (1+ cnt))
);while
);defun
[/font]

[font=courier new] 
(defun C:NUM () 
(setq ss1 (ssget) 
      len1 (sslength ss1) 
      cnt 0 
      add (getreal "\nEnter number to add to elevations:  ") 
      ) 
(while (< cnt len1) 
  (setq dent (entget (ssname ss1 cnt)) 
        txt (cdr (assoc 1 dent)) 
        len (strlen txt) 
        cnt1 1 
        ) 
   (while (<= cnt1 len) 
    (if (/= (substr txt cnt1 1) " ") 
     (progn 
      (setq num (atof (substr txt cnt1 len)) 
            numlen (strlen (rtos num 2 5))) 
       (if (/= num 0) 
         (progn    
          (cond ((= (substr txt cnt1 numlen) (rtos num 2 5)) (setq sp 0)) 
                ((= (substr txt cnt1 (- numlen 1)) (rtos num 2 1)) (setq sp 1)) 
                ((= (substr txt cnt1 (- numlen 3)) (rtos num 2 0)) (setq sp 3)) 
            );cond       
            (setq rtxt (substr txt (- (+ cnt1 numlen) sp) len) 
                  num (+ add num) 
                  numt (rtos num 2 5) 
                  ntx  (strcat (substr txt 1 (-  cnt1 1)) numt rtxt) 
                  old (assoc 1 dent) 
                  new (cons 1 ntx) 
                  dent (subst new old dent)    
                  cnt1 (+ 1 len) 
               );setq 
                (entmod dent) 
               );progn 
             )));if,progn,if 
        (setq cnt1 (1+ cnt1))       
      );end while 
  (setq cnt (1+ cnt))    
 );while 
);defun 
[/font]

cjrun · 发表于 2003-4-10 11:47:48

哈。。哈。。
我正需要这个，以前我编的不太好用，呵。。
不劳而获了
谢谢！

lsjjm · 发表于 2003-4-10 12:13:59

是否太繁琐了? 用mapcar函数不是很简单吗?

urljit · 发表于 2003-4-15 10:06:22

不过，对不起，今天我没有带来

zongzhenxi · 发表于 2003-4-23 10:29:50

该程序在修改较大数时，就不灵通了。我是初学者，能不能再修改一下，重新定义一下数的精度

wlz088 · 发表于 2003-4-25 08:24:56

如果是a1~a8这样的系列就不能执行，能否改进一下？

cy956 · 发表于 2003-5-2 00:33:16

贴一个以前的程序，后来没再处理：

(defun c:sxys(/ A B1 D72 D73 DW E EN H IN K-SXYS
K-YS LAY N P0 P1 S TXT TXT1 TXT2 WS)
(diag-sxys)
(prompt "\n选择要统一修改的文字:")
(setq s(ssget '((0 . "TEXT")) ) n(sslength s) in 0)
(repeat n
(setq e(ssname s in) in (1+ in)
en(entget e) txt (atof (dxf 1 en))
p0(dxf 10 en)h(dxf 40 en)lay(dxf 8 en)
a(dxf 50 en)p1(polar p0 (- a a:pi2) (* 1.5 h))
d72 (dxf 72 en)d73(dxf 73 en))
(if (and k-sxys k-ys ws (if (member k-ys '("1" "2" "3")) b1 T))(progn
(cond
((= k-ys "1")(setq txt1(rtos (+ txt b1) 2 ws)
txt2(strcat (rtos txt 2 ws) (if (> b1 0)"+" "-") (rtos (abs b1) 2 ws)"=")))
((= k-ys "2")(setq txt1(rtos (* txt b1) 2 ws)
txt2(strcat (rtos txt 2 ws) "x" (rtos b1 2 ws)"=")))
((= k-ys "3")(setq txt1(rtos (/ txt b1) 2 ws)
txt2(strcat (rtos txt 2 ws) "/" (rtos b1 2 ws)"=")))
((= k-ys "4")(setq txt1(rtos (* txt txt) 2 ws)
txt2(strcat (rtos txt 2 ws) "平方=")))
((= k-ys "5")(setq txt1(rtos (* (rtos txt 2 ws) (rtos txt 2 ws) (rtos txt 2 ws)) 2 ws)
txt2(strcat (rtos txt 2 ws) "三次方=")))
((= k-ys "6")(setq txt1(rtos (SQRT txt) 2 ws)
txt2(strcat (rtos txt 2 ws) "开平方=")))
)
(if (and dw (= (type dw) 'str))(setq txt1(strcat txt1 dw)))
(if (= k-sxls "1")(progn
(#m_txt p1 txt2 "DXFS" h 0.7 a d72 d73 lay -1)
(setq p1(polar p1 (- a a:pi2) (* 1.5 h)))
(#m_txt p1 txt1 "DXFS" h 0.7 a d72 d73 lay -1)
)
(#m_txt p1 txt1 "DXFS" h 0.7 a d72 d73 lay -1)
)
) )
)
)
(DEFUN diag-sxys (/ dcl_id dcl_id i )
(setq k-sxys T ws 2)
(IF (> (SETQ dcl_id (LOAD_DIALOG "jz8")) 0)(PROGN
(IF (NEW_DIALOG "sxys" dcl_id)(PROGN
(setq k-ys "1")
(set_tile "b2" (itoa ws))
(set_tile (strcat "a" k-ys) "1")
(set_tile "b5" (if k-sxls k-sxls "0"))
(ACTION_TILE "a1" "(setq k-ys "1")(mode_tile "b1" 0)")
(ACTION_TILE "a2" "(setq k-ys "2")(mode_tile "b1" 0)")
(ACTION_TILE "a3" "(setq k-ys "3")(mode_tile "b1" 0)")
(ACTION_TILE "a4" "(setq k-ys "4")(mode_tile "b1" 1)")
(ACTION_TILE "a5" "(setq k-ys "5")(mode_tile "b1" 1)")
(ACTION_TILE "a6" "(setq k-ys "6")(mode_tile "b1" 1)")
;==
(ACTION_TILE "b1" "(setq b1(distof $value))")
(ACTION_TILE "b2" "(setq ws(atoi $value))")
(ACTION_TILE "b3" "(setq dw $value)")
(ACTION_TILE "b4" "(dw-sxys)")
(ACTION_TILE "b5" "(setq k-sxls $value)")
(ACTION_TILE"accept" "(ok-sxys)(done_dialog 1)")
;;; (ACTION_TILE"help""(info_box_cyck-st)")
(ACTION_TILE "cancel" "(setq k-sxys nil)")
(START_DIALOG))
(PROMPT "\n无法显示对话框,请检查!")
)
(UNLOAD_DIALOG dcl_id))
(PRINC (STRCAT "\n无法加载对话框文件" tdcl ".DCL,请检查!"))
)
)
(defun dw-sxys()
(setq xyz '("m%%1412%%142" "千米%%1412%%142" "米""户")
dw(dos_combolist "--by陈勇--" "选择一个单位" xyz "m%%1412%%142"))
(set_tile "b3" dw)
)
(defun ok-sxys()
(setq b1(atof(get_tile "b1"))
ws(atoi(get_tile "b2"))
dw(get_tile "b3")
k-sxls(get_tile "b5"))
)
;;;内部函数
(defun #m_txt (pt txt sty th wid tan d72 d73 lay color /)
(if (and (= d72 0)(= d73 0))
(setq en000 (list
(cons 0 "TEXT")
(cons 1 txt)
(cons 7 sty)
(cons 8 lay)
(cons 10 pt)
(cons 40 th)
(cons 41 wid)
(cons 50 tan)
(cons 72 d72)
(cons 73 d73) ) )
(setq en000 (list
(cons 0 "TEXT")
(cons 1 txt)
(cons 7 sty)
(cons 8 lay)
(cons 10 pt)
(cons 11 pt)
(cons 40 th)
(cons 41 wid)
(cons 50 tan)
(cons 72 d72)
(cons 73 d73) ) )
)
(IF (= STY "STANDARD")(setq en000 (append en000 (list (cons 51 0.261799)))))
(if (/= -1 color) (setq en000 (append en000 (list (cons 62 color)))))
(if (= nil (entmake en000)) (princ "\n制造 TEXT 实体失败.") )
)

(defun c:sxys(/ A B1 D72 D73 DW E EN H IN K-SXYS 
              K-YS LAY N P0 P1 S TXT TXT1 TXT2 WS) 
  (diag-sxys) 
  (prompt "\n选择要统一修改的文字:") 
  (setq s(ssget '((0 . "TEXT")) ) n(sslength s) in 0) 
  (repeat n 
    (setq e(ssname s in) in (1+ in) 
          en(entget e) txt (atof (dxf 1 en)) 
          p0(dxf 10 en)h(dxf 40 en)lay(dxf 8 en) 
          a(dxf 50 en)p1(polar p0 (- a a:pi2) (* 1.5 h)) 
          d72 (dxf 72 en)d73(dxf 73 en)) 
    (if (and k-sxys k-ys ws (if (member k-ys '("1" "2" "3")) b1 T))(progn 
      (cond 
        ((= k-ys "1")(setq txt1(rtos (+ txt b1) 2 ws) 
                           txt2(strcat (rtos txt 2 ws) (if (> b1 0)"+" "-") (rtos (abs b1) 2 ws)"="))) 
        ((= k-ys "2")(setq txt1(rtos (* txt b1) 2 ws) 
                           txt2(strcat (rtos txt 2 ws) "x" (rtos b1 2 ws)"="))) 
        ((= k-ys "3")(setq txt1(rtos (/ txt b1) 2 ws) 
                           txt2(strcat (rtos txt 2 ws) "/" (rtos b1 2 ws)"="))) 
        ((= k-ys "4")(setq txt1(rtos (* txt txt) 2 ws) 
                           txt2(strcat (rtos txt 2 ws) "平方="))) 
        ((= k-ys "5")(setq txt1(rtos (* (rtos txt 2 ws) (rtos txt 2 ws) (rtos txt 2 ws)) 2 ws) 
                           txt2(strcat (rtos txt 2 ws) "三次方="))) 
        ((= k-ys "6")(setq txt1(rtos (SQRT txt) 2 ws) 
                           txt2(strcat (rtos txt 2 ws) "开平方="))) 
      ) 
      (if (and dw (= (type dw) 'str))(setq txt1(strcat txt1 dw))) 
      (if (= k-sxls "1")(progn 
        (#m_txt p1 txt2  "DXFS" h 0.7 a d72 d73 lay -1) 
        (setq p1(polar p1 (- a a:pi2) (* 1.5 h))) 
        (#m_txt p1 txt1 "DXFS" h 0.7 a d72 d73 lay -1) 
        ) 
        (#m_txt p1 txt1 "DXFS" h 0.7 a d72 d73 lay -1) 
      ) 
    ) ) 
  ) 
) 
(DEFUN diag-sxys (/ dcl_id dcl_id i ) 
  (setq k-sxys T ws 2) 
  (IF (> (SETQ dcl_id (LOAD_DIALOG "jz8")) 0)(PROGN 
    (IF (NEW_DIALOG "sxys" dcl_id)(PROGN 
      (setq k-ys "1") 
      (set_tile "b2" (itoa ws)) 
      (set_tile (strcat "a" k-ys) "1") 
      (set_tile "b5" (if k-sxls k-sxls "0")) 
      (ACTION_TILE "a1" "(setq k-ys "1")(mode_tile "b1" 0)") 
      (ACTION_TILE "a2" "(setq k-ys "2")(mode_tile "b1" 0)") 
      (ACTION_TILE "a3" "(setq k-ys "3")(mode_tile "b1" 0)") 
      (ACTION_TILE "a4" "(setq k-ys "4")(mode_tile "b1" 1)") 
      (ACTION_TILE "a5" "(setq k-ys "5")(mode_tile "b1" 1)") 
      (ACTION_TILE "a6" "(setq k-ys "6")(mode_tile "b1" 1)") 
      ;== 
      (ACTION_TILE "b1" "(setq b1(distof $value))") 
      (ACTION_TILE "b2" "(setq ws(atoi $value))") 
      (ACTION_TILE "b3" "(setq dw $value)") 
      (ACTION_TILE "b4" "(dw-sxys)") 
      (ACTION_TILE "b5" "(setq k-sxls $value)") 
      (ACTION_TILE"accept" "(ok-sxys)(done_dialog 1)") 
;;;      (ACTION_TILE"help""(info_box_cyck-st)") 
      (ACTION_TILE "cancel" "(setq k-sxys nil)") 
      (START_DIALOG)) 
      (PROMPT "\n无法显示对话框,请检查!") 
    ) 
    (UNLOAD_DIALOG dcl_id)) 
    (PRINC (STRCAT "\n无法加载对话框文件" tdcl ".DCL,请检查!")) 
  ) 
) 
(defun dw-sxys() 
  (setq xyz '("m%%1412%%142" "千米%%1412%%142" "米""户") 
        dw(dos_combolist "--by陈勇--" "选择一个单位" xyz "m%%1412%%142")) 
  (set_tile "b3" dw) 
) 
 
 
(defun ok-sxys() 
  (setq        b1(atof(get_tile "b1")) 
        ws(atoi(get_tile "b2")) 
        dw(get_tile "b3") 
        k-sxls(get_tile "b5")) 
) 
 
;;;内部函数 
(defun #m_txt (pt txt sty th wid tan d72 d73 lay color /) 
 (if (and (= d72 0)(= d73 0)) 
  (setq en000 (list 
      (cons 0 "TEXT") 
      (cons 1 txt) 
      (cons 7 sty) 
      (cons 8 lay) 
      (cons 10 pt) 
      (cons 40 th) 
      (cons 41 wid) 
      (cons 50 tan) 
      (cons 72 d72) 
      (cons 73 d73)   ) ) 
  (setq en000 (list 
      (cons 0 "TEXT") 
      (cons 1 txt) 
      (cons 7 sty) 
      (cons 8 lay) 
      (cons 10 pt) 
      (cons 11 pt) 
      (cons 40 th) 
      (cons 41 wid) 
      (cons 50 tan) 
      (cons 72 d72) 
      (cons 73 d73)   ) ) 
  ) 
  (IF (= STY "STANDARD")(setq en000 (append en000 (list (cons 51 0.261799))))) 
  (if (/= -1 color) (setq en000 (append en000 (list (cons 62 color))))) 
  (if (= nil (entmake en000)) (princ "\n制造 TEXT 实体失败.")  ) 
)

cy956 · 发表于 2003-5-2 00:37:31

下面是dcl

梦断江南 · 发表于 2003-5-2 02:16:08

(princ "\ntadd=====txt数字加减值,改精度----------- lxx.2001.6")
(defun c:tadd ( / ss i nall ent entl i nmb nall nalls k dec)
(princ "\ntcal=====txt数字加减值,改精度----------- lxx.2001.6")
(setq ss (ssget '((0 . "TEXT")))
i 0
nadd (getdist "\n加值(可为负值;直接回车改精度):")
dec (getint "\n精度<0>:")
)
(if (not nadd)(setq nadd 0))
(if (not dec)(setq dec 0))
(repeat (sslength ss)
(setq ent (ssname ss i)
entl (entget ent)
i (1+ i)
nmb (cdr(assoc 1 entl))
)
(if (or (= 'REAL (type (read nmb)))(= 'INT (type (read nmb))))
(progn
(setq nmb (atof nmb)
endn (+ nmb nadd)
nmb (rtos endn 2 dec)
entl (subst (cons 1 nmb)(assoc 1 entl) entl)
)
(entmod entl)
)
);;end if
) ;;end repeat
(princ)
)
;;;;

(princ "\ntadd=====txt数字加减值,改精度----------- lxx.2001.6") 
(defun c:tadd ( / ss i nall ent entl i nmb nall nalls k dec) 
  (princ "\ntcal=====txt数字加减值,改精度----------- lxx.2001.6") 
  (setq ss (ssget '((0 . "TEXT"))) 
        i 0 
        nadd (getdist "\n加值(可为负值;直接回车改精度):") 
        dec (getint "\n精度<0>:") 
  ) 
  (if (not nadd)(setq nadd 0)) 
  (if (not dec)(setq dec 0)) 
  (repeat (sslength ss) 
    (setq ent (ssname ss i) 
          entl (entget ent) 
          i (1+ i) 
          nmb (cdr(assoc 1 entl)) 
    ) 
    (if (or (= 'REAL (type (read nmb)))(= 'INT (type (read nmb)))) 
        (progn 
          (setq  nmb (atof nmb) 
               endn (+ nmb nadd) 
                 nmb (rtos endn 2 dec) 
               entl (subst (cons 1 nmb)(assoc 1 entl) entl) 
          ) 
        (entmod entl) 
        ) 
    );;end if 
  )  ;;end repeat 
  (princ) 
) 
;;;;

PFD8667 · 发表于 2004-7-29 15:06:44

不知怎么使用?给个演示就好了

cdma2546 · 发表于 2009-11-5 09:51:53

想下载但是积分不够！

yuguole · 发表于 2009-11-5 12:36:28

defun c: 后面是命令自己可以看看
下了谢啦

tekken999 · 发表于 2009-11-28 11:23:15

9楼的很好用，哈哈谢谢了，

lzj511 · 发表于 2009-11-29 02:21:50

(defun test (x)
  (setq sgt (ssget '((0 . "text"))))
  (setq ii 0)
  (repeat (sslength sgt)
(setq ent (ssname sgt ii))
(setq entlst (entget ent))
(setq str (cdr (assoc 1 entlst)))
(setq num (atof str))
(setq num (+ num x))
(setq str2 (rtos num))
(setq namelst (subst (cons 1 str2) (assoc '1 entlst) entlst))
(entmod namelst)
(setq ii (1+ ii))
  ) ;_ ½áÊørepeat
) ;_ ½áÊødefun

yewuqiang · 发表于 2009-12-1 14:43:14

9楼的黏贴下来直接放在text文本里用好像不行？

呵呵，好像是把\"替换为"就可以了，自己搞错了

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

[分享]：给选定的一组数字统一加上或减去一个数值

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

相关帖子