谁能帮我写改编号尾数的程序？

zyhandw

这么个小程序对你来说应该不是什么难题啊，简单写了下，你自己调试再改下！

2. (defun c:een()
   
3. (setq n 0)
   
4.   (if (setq ss (ssget '((0 . "text"))))
   
5.       (repeat (sslength ss)
   
6.          (setq txt-lst (entget (ssname ss n)))
   
7.          (setq txt-str (cdr (assoc '1 txt-lst)))
   
8.          (setq sec (substr txt-str (strlen txt-str)))
   
9.          (setq firs (substr txt-str '1 (- (strlen txt-str) 1)))
   
10.          (setq sec-i-str (itoa (+ (atoi sec) 1)))
    
11.          (setq txt-str (strcat firs sec-i-str))
    
12.          (setq txt-lst (subst (cons '1 txt-str) (assoc '1 txt-lst) txt-lst))
    
13.          (entmod txt-lst)
    
14.          (setq n (1+ n))
    
15.       )
    
16.   )
    
17. (princ)
    
18. )

(defun c:een()<br /> (setq n 0)<br />   (if (setq ss (ssget '((0 . "text"))))<br />       (repeat (sslength ss)<br />          (setq txt-lst (entget (ssname ss n)))<br />          (setq txt-str (cdr (assoc '1 txt-lst)))<br />          (setq sec (substr txt-str (strlen txt-str)))<br />          (setq firs (substr txt-str '1 (- (strlen txt-str) 1)))<br />          (setq sec-i-str (itoa (+ (atoi sec) 1)))<br />          (setq txt-str (strcat firs sec-i-str))<br />          (setq txt-lst (subst (cons '1 txt-str) (assoc '1 txt-lst) txt-lst))<br />          (entmod txt-lst)<br />          (setq n (1+ n))<br />       )<br />   )<br /> (princ)<br /> )

半听可乐

Andyhon 发表于 2012-9-25 15:31
(setq ss (ssget "X" '((0 . "TEXT") (1 . "*-#")))
  ===>
  (setq ss (ssget '((0 . "TEXT") (1 . "* ...

非常感谢！这样的功能真是太方便了！

半听可乐

Andyhon 发表于 2012-9-25 15:31
(setq ss (ssget "X" '((0 . "TEXT") (1 . "*-#")))
  ===>
  (setq ss (ssget '((0 . "TEXT") (1 . "* ...

为了方便其他朋友，我把完整程序附上，谢谢Andyhon长老！

;;;-------------------------------------------------------------------------------------------------------------------
;;; ★gws  改尾数
;;;   By  Andyhon
;;;-------------------------------------------------------------------------------------------------------------------
(defun C:gws()
(setq ss (ssget '((0 . "TEXT") (1 . "*#")))
       Num (getstring "\n新的编号: ")
        i  0
  )
  (while (setq ee (ssname ss i))
    (setq obj (vlax-ename->vla-object ee)
          txt (vla-get-textstring obj)
          txt (reverse (vl-string->list txt))
          txt (vl-list->string (reverse (cdr txt)))
          i   (1+ i)
    )
    (vla-put-textstring obj (strcat txt Num))
  )
)

lty

哈哈，又长知识了！

crazylsp

;_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
;试用
;递增1按+
;递减1按-
(defun een()
      (setq n 0)
      (repeat (sslength (ssget "P"))
         (setq txt-lst (entget (ssname ss n)))
         (setq txt-str (cdr (assoc '1 txt-lst)))
         (setq sec (substr txt-str (strlen txt-str)))
         (setq firs (substr txt-str '1 (- (strlen txt-str) 1)))
         (setq sec-i-str (itoa (+ (atoi sec) 1)))
         (setq txt-str (strcat firs sec-i-str))
         (setq txt-lst (subst (cons '1 txt-str) (assoc '1 txt-lst) txt-lst))
         (entmod txt-lst)
         (setq n (1+ n))
      )
(princ)
)
(defun eem()
      (setq n 0)
      (repeat (sslength (ssget "P"))
         (setq txt-lst (entget (ssname ss n)))
         (setq txt-str (cdr (assoc '1 txt-lst)))
         (setq sec (substr txt-str (strlen txt-str)))
         (setq firs (substr txt-str '1 (- (strlen txt-str) 1)))
         (setq sec-i-str (itoa (- (atoi sec) 1)))
         (setq txt-str (strcat firs sec-i-str))
         (setq txt-lst (subst (cons '1 txt-str) (assoc '1 txt-lst) txt-lst))
         (entmod txt-lst)
         (setq n (1+ n))
      )
(princ)
)
(vl-load-com)
(defun c:tt()
   (if(setq ss (ssget '((0 . "text"))))
    (repeat 88
     (if (and (=(car(grread))2)(= (cadr(grread))43))
         (een)
      )
     (if(and (=(car(grread))2)(= (cadr(grread))45))
        (eem)
      )
    )
  )
)
;
;_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
;

半听可乐

crazylsp 发表于 2012-9-26 13:04
;_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
;试用
;递增1按+
...

不管用~没反应 的

crazylsp

多按几次就可以了。

aaacjh

crazylsp 发表于 2012-9-26 17:47
多按几次就可以了。

是诶,多按几次才有反应.思路学习前辈.请教前辈! getread 函数针对键盘输入(2),是否有个对于表可供查询?

aaacjh

半听可乐 发表于 2012-9-25 15:50
为了方便其他朋友，我把完整程序附上，谢谢Andyhon长老！

;;;-------------------------------------- ...

vla-get-textstring 像这种vla开头的是什么函数,请教!,在常规的帮助文件中查不到.

aaacjh

Andyhon 发表于 2012-9-25 14:43
是让您自行参考后修订

这样试吧!

vla-get-textstring 像这种vla开头的是什么函数,请教!,在常规的帮助文件中查不到.