字母递增复制
求(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)
)求将字母原位递增改为递增复制的方法
怎么网上净是原位递增的，就没有递增复制的，递增复制数字的那个好麻烦，难道就那么难。请大侠们帮助
难道这个还不能解决你的问题吗。
http://bbs.mjtd.com/thread-100800-1-1.html 我原来写了复制递增，或许你可参考一下
http://bbs.mjtd.com/thread-102143-1-1.html edata 发表于 2013-11-27 22:00 static/image/common/back.gif
难道这个还不能解决你的问题吗。
http://bbs.mjtd.com/thread-100800-1-1.html
我只要字母的，比如A之后是B,B之后是C，如此而已。一般编号不超过26个的 本帖最后由 llsheng_73 于 2013-11-28 16:13 编辑
偏爱云~小吴 发表于 2013-11-28 15:02 static/image/common/back.gif
我只要字母的，比如A之后是B,B之后是C，如此而已。一般编号不超过26个的
(defun c:zm1 (/ mycopy mymove SstoEs sign ss p1 p2)
(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"复制基点"))
(setq p2(getpoint p1"复制到"))
(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)
(princ)
)
没来得及处理最后是数字的 这个网上太多了 (defun c:cptxt( / ang dis en l loop n p1 p2 sn st)
(command "undo" "g")
(princ "\n欢迎使用文字或属性块连续增量拷贝程序! GYSJY2009.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
(setqsn1(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 static/image/common/back.gif
(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 -1s2(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)
)