字母递增复制

偏爱云~小吴

求(defun c:zm1 () (defun sign (nn) (if (< nn 0) -1 (if (> nn 0) 1 0)))
(setq ind (getint "\n输入增减量<1> :")
       ind (if ind ind 1))
(while (and (setq s1 (entsel "\n选择字串 :"))
             (setq ent (entget(car s1)))
             (= (cdr(assoc 0 ent)) "MTEXT"))
  (setq txt (cdr(assoc 1 ent))
        txt1 (substr txt (strlen txt) 1))
  (cond
   ((and(= txt1 "A") (< ind 0)) (setq txt1 "z"))
   ((and(= txt1 "a") (< ind 0)) (setq txt1 "Z"))
   ((and(= txt1 "Z") (> ind 0)) (setq txt1 "a"))
   ((and(= txt1 "z") (> ind 0)) (setq txt1 "A"))
   (T (setq txt1 (chr (+ (ascii txt1) (sign ind)))))
  )
  (setq txt (strcat (substr txt 1 (1- (strlen txt))) txt1)
        ent (subst (cons 1 txt) (assoc 1 ent) ent))
  (entmod ent)
)
(princ)
)求将字母原位递增改为递增复制的方法

偏爱云~小吴

怎么网上净是原位递增的，就没有递增复制的，递增复制数字的那个好麻烦，难道就那么难。请大侠们帮助

edata

难道这个还不能解决你的问题吗。
http://bbs.mjtd.com/thread-100800-1-1.html

自贡黄明儒

我原来写了复制递增，或许你可参考一下
http://bbs.mjtd.com/thread-102143-1-1.html

偏爱云~小吴

edata 发表于 2013-11-27 22:00
难道这个还不能解决你的问题吗。
http://bbs.mjtd.com/thread-100800-1-1.html

我只要字母的，比如A之后是B,B之后是C，如此而已。一般编号不超过26个的

llsheng_73

偏爱云~小吴 发表于 2013-11-28 15:02
我只要字母的，比如A之后是B,B之后是C，如此而已。一般编号不超过26个的

1. (defun c:zm1 (/ mycopy mymove SstoEs sign ss p1 p2)
   
2.   (defun SstoEs(ss / a en lst)
   
3.     (if ss(progn(setq a -1)(while(setq en(ssname ss(setq a(1+ a))))(setq lst (cons en lst)))))
   
4.     lst)
   
5.   (defun sign (nn) (if (< nn 0) -1 (if (> nn 0) 1 0)))
   
6.   (defun mycopy(ss p p1 / ty q q1 s1 s2);;参照by-xyp1964的xyp-ScaleEntity
   
7.     (setq ty(type ss)i -1
   
8.     s2(ssadd)
   
9.     q1(vlax-3D-point(trans p1 0 0))
   
10.     q(vlax-3D-point(trans p 0 0)))
    
11.     (cond((= ty 'ENAME)(vla-move(vla-copy(vlax-ename->vla-object ss))q q1)(setq s2(ssadd(entlast)s2)))
    
12.    ((= ty 'PICKSET)
    
13.     (setq i -1)
    
14.     (while (setq s1 (ssname ss (setq i (1+ i))))
    
15.       (mycopy s1 p p1)(setq s2(ssadd(entlast)s2))))
    
16.    ((= ty 'LIST)(foreach x ss(mycopy x p p1)(setq s2(ssadd(entlast)s2))))
    
17.    )s2)
    
18.   (defun mymove(ss p p1 / ty q q1 s1);;参照by-xyp1964的xyp-ScaleEntity
    
19.     (setq ty(type ss)i -1
    
20.     q1(vlax-3D-point(trans p1 0 0))
    
21.     q(vlax-3D-point(trans p 0 0)))
    
22.     (cond((= ty 'ENAME)(vla-move(vlax-ename->vla-object ss)q q1))
    
23.    ((= ty 'PICKSET)
    
24.     (setq i -1)
    
25.     (while (setq s1 (ssname ss (setq i (1+ i))))
    
26.       (mymove s1 p p1)))
    
27.    ((= ty 'LIST)(foreach x ss(mymove x p p1))))
    
28.     )
    
29.   (setq ind (getint "\n输入增减量<1> :")
    
30.         ind (sign ind))
    
31.   (prompt"\n选择要进行递增复制的文字、属性")
    
32.   (setq ss(SstoEs(ssget'((0 . "*TEXT,ATTDEF")))))
    
33.   (setq p1(getpoint"复制基点"))
    
34.   (setq p2(getpoint p1"复制到"))
    
35.   (mycopy (setq ss(vl-remove'nil(mapcar'(lambda(x)(setq e(entget x))
    
36.       (if(assoc 1 e)
    
37.         (progn(setq tx(vl-string->list (cdr(assoc 1 e))))
    
38.     (if(OR(<(IF(> ind 0)65 66)(last tx)(IF(> ind 0)89 90))
    
39.           (<(IF(> ind 0)97 98)(last tx)(IF(> ind 0)121 122)))x))))ss)))p1 p1)
    
40.   (mymove ss p1 p2)
    
41.   (mapcar'(lambda(x)(entmod(setq e(entget x)
    
42.         tx(vl-string->list (cdr(assoc 1 e)))
    
43.         e(subst(cons 1 (vl-list->string(reverse(cons((IF(> ind 0)1+ 1-)(last tx))(cdr(reverse tx))))))(assoc 1 e)e)))
    
44.       nil)ss)
    
45. (princ)
    
46. )

(defun c:zm1 (/ mycopy mymove SstoEs sign ss p1 p2)<br />   (defun SstoEs(ss / a en lst)<br />     (if ss(progn(setq a -1)(while(setq en(ssname ss(setq a(1+ a))))(setq lst (cons en lst)))))<br />     lst)<br />   (defun sign (nn) (if (< nn 0) -1 (if (> nn 0) 1 0)))<br />   (defun mycopy(ss p p1 / ty q q1 s1 s2);;参照by-xyp1964的xyp-ScaleEntity<br />     (setq ty(type ss)i -1<br />     s2(ssadd)<br />     q1(vlax-3D-point(trans p1 0 0))<br />     q(vlax-3D-point(trans p 0 0)))<br />     (cond((= ty 'ENAME)(vla-move(vla-copy(vlax-ename->vla-object ss))q q1)(setq s2(ssadd(entlast)s2)))<br />    ((= ty 'PICKSET)<br />     (setq i -1)<br />     (while (setq s1 (ssname ss (setq i (1+ i))))<br />       (mycopy s1 p p1)(setq s2(ssadd(entlast)s2))))<br />    ((= ty 'LIST)(foreach x ss(mycopy x p p1)(setq s2(ssadd(entlast)s2))))<br />    )s2)<br />   (defun mymove(ss p p1 / ty q q1 s1);;参照by-xyp1964的xyp-ScaleEntity<br />     (setq ty(type ss)i -1<br />     q1(vlax-3D-point(trans p1 0 0))<br />     q(vlax-3D-point(trans p 0 0)))<br />     (cond((= ty 'ENAME)(vla-move(vlax-ename->vla-object ss)q q1))<br />    ((= ty 'PICKSET)<br />     (setq i -1)<br />     (while (setq s1 (ssname ss (setq i (1+ i))))<br />       (mymove s1 p p1)))<br />    ((= ty 'LIST)(foreach x ss(mymove x p p1))))<br />     )<br />   (setq ind (getint "\n输入增减量<1> :")<br />         ind (sign ind))<br />   (prompt"\n选择要进行递增复制的文字、属性")<br />   (setq ss(SstoEs(ssget'((0 . "*TEXT,ATTDEF")))))<br />   (setq p1(getpoint"复制基点"))<br />   (setq p2(getpoint p1"复制到"))<br />   (mycopy (setq ss(vl-remove'nil(mapcar'(lambda(x)(setq e(entget x))<br />       (if(assoc 1 e)<br />         (progn(setq tx(vl-string->list (cdr(assoc 1 e))))<br />     (if(OR(<(IF(> ind 0)65 66)(last tx)(IF(> ind 0)89 90))<br />           (<(IF(> ind 0)97 98)(last tx)(IF(> ind 0)121 122)))x))))ss)))p1 p1)<br />   (mymove ss p1 p2)<br />   (mapcar'(lambda(x)(entmod(setq e(entget x)<br />         tx(vl-string->list (cdr(assoc 1 e)))<br />         e(subst(cons 1 (vl-list->string(reverse(cons((IF(> ind 0)1+ 1-)(last tx))(cdr(reverse tx))))))(assoc 1 e)e)))<br />       nil)ss)<br /> (princ)<br /> )

没来得及处理最后是数字的

注册

这个网上太多了

注册

(defun c:cptxt( / ang dis en l loop n p1 p2 sn st)
  (command "undo" "g")
  (princ "\n欢迎使用文字或属性块连续增量拷贝程序! GYSJY  2009.3.9更新")
  (if (setq sn (entsel "\n点取物体:"))
    (progn
      (setq p1 (getpoint "\n基点:" )  p2 t sn (car sn) loop t)
      (if (or (= "TEXT" (to 0))(and p2 (to 66)(= "INSERT" (to 0))))
        (progn                                                
          (tqwz)
          (tqtxt)
          (setq l (1+ l ))
          (while p2
            (initget "A")
            (setq p2 (getpoint "\nA单行阵列/下一点:" p1))
            (if (= p2 "A")
              (progn
                (setq p2 (getpoint "\n第二点:" p1)
                      dis (distance p1 p2) ang (angle p1 p2)
                      n (getint "\n拷贝个数<2>:")
                )
                (if (= n nil)(setq n 2))              
                (repeat (1- n)  
                  (command "copy" sn "" p1 p2)
                  (setq sn (entlast) p1 p2 en (entget sn)
                        p2 (polar p1 ang dis)
                  )
                  (tqwz)(chtxt)
                )
                ;(setq p2 nil)
              )
            )
            (command "copy" sn "" p1 p2)   
            (setq sn (entlast) p1 p2 en (entget sn))
            (tqwz)
            (chtxt)
            (princ st)
          )
        )
        (princ "\n   ***你所点取的图元不是属性块或文字!本程序只拷贝带属性的块或文字。***")
      )
        )
  )
  (command "undo" "e")
  (princ)
)
(defun chtxt()
            (setq asc (ascii st))
            (if p2
              (if (and (= (strlen st) 1)
                    (or (and (> asc 64) (< asc 90))
                        (and (> asc 96) (< asc 122))
                    )
                  );判断字符串是否是单个字母
                (setq k (if (or (= asc 78)(= asc 72))(+ asc 2)(1+ asc));排除字母I,O
                      st (chr k)
                ) ;如果字符串是单个字母，则按字母顺序增长              
                (setq st2 (substr st l) st2 (tost2)
                      st (strcat st1 st2)  
                ) ;按数字增长
              )
            )
            (if (= "TEXT" (to 0))
              (progn
                (setq e1 (subst (cons 1 st) (assoc 1 en) en))
                (entmod e1)
              );修改文字
              (if (or loop p)
                (progn
                  (setq e1 (entget (entnext (cdr (car en)))))
                  (setq e1 (subst (cons 1 st) (assoc 1 e1) e1))
                  (entmod e1)(entmod en)
                )
                (progn
                  (setq  sn1(entnext sn) en1 (entget sn1)
                     e1 (entget (entnext (cdr (car en1))))
                     e2 (subst (cons 1 st) (assoc 1 e1) e1)
                  )
                  (entmod e2)(entmod en1)(entmod en)
                )
              );修改属性
            )
)   
借花献佛

偏爱云~小吴

注册 发表于 2013-11-28 21:38
(defun c:cptxt( / ang dis en l loop n p1 p2 sn st)
  (command "undo" "g")
  (princ "\n欢迎使用文字 ...

貌似没有办法解决问题，我要的只是A到B然后到C，连续复制

偏爱云~小吴

递减时候出错，再改成框选就好了
(defun c:zm1 (/ mycopy mymove SstoEs sign ss p1 p2)
  (vl-load-com)
  (defun SstoEs(ss / a en lst)
    (if ss(progn(setq a -1)(while(setq en(ssname ss(setq a(1+ a))))(setq lst (cons en lst)))))
    lst)
  (defun sign (nn) (if (< nn 0) 1 (if (> nn 0) -1 0)))
  (defun mycopy(ss p p1 / ty q q1 s1 s2);;参照by-xyp1964的xyp-ScaleEntity
    (setq ty(type ss)i -1  s2(ssadd)  q1(vlax-3D-point(trans p1 0 0))  q(vlax-3D-point(trans p 0 0)))
    (cond((= ty 'ENAME)(vla-move(vla-copy(vlax-ename->vla-object ss))q q1)(setq s2(ssadd(entlast)s2)))
         ((= ty 'PICKSET)(setq i -1)  (while (setq s1 (ssname ss (setq i (1+ i))))
                                        (mycopy s1 p p1)(setq s2(ssadd(entlast)s2))))
         ((= ty 'LIST)(foreach x ss(mycopy x p p1)(setq s2(ssadd(entlast)s2))))
         )s2)
  (defun mymove(ss p p1 / ty q q1 s1);;参照by-xyp1964的xyp-ScaleEntity
    (setq ty(type ss)i -1
          q1(vlax-3D-point(trans p1 0 0)) q(vlax-3D-point(trans p 0 0)))
    (cond((= ty 'ENAME)(vla-move(vlax-ename->vla-object ss)q q1))
         ((= ty 'PICKSET)(setq i -1)
          (while (setq s1 (ssname ss (setq i (1+ i))))
            (mymove s1 p p1)))
         ((= ty 'LIST)(foreach x ss(mymove x p p1))))
    )
  (setq ind (getint "\n输入增减量<1> :")ind (sign ind))
  (prompt"\n选择要进行递增复制的文字、属性")
  (setq ss(SstoEs(ssget'((0 . "*TEXT,ATTDEF")))))
  (setq p1(getpoint"复制基点"))
  (while(and(setq p2(getpoint p1"复制到(右键退出)"))ss)
    (mycopy(setq ss(vl-remove'nil(mapcar'(lambda(x)(setq e(entget x))
                                            (if(assoc 1 e)
                                              (progn(setq tx(vl-string->list (cdr(assoc 1 e))))
                                                (if(OR(<=(IF(> ind 0)65 66)(last tx)(IF(> ind 0)89 90))
                                                      (<=(IF(> ind 0)97 98)(last tx)(IF(> ind 0)121 122)))x))))ss)))p1 p1)
    (mymove ss p1 p2)
    (mapcar'(lambda(x)(entmod(setq e(entget x)tx(vl-string->list (cdr(assoc 1 e)))
                                   e(subst(cons 1 (vl-list->string(reverse(cons((IF(> ind 0)1+ 1-)(last tx))(cdr(reverse tx))))))(assoc 1 e)e)))
              nil)ss)
    (setq p1 p2))
  (princ)
)