最初由 xuyu 发布

[B]楼主是否可以做到这样呢，在做图纸的编号时复制，增量复制时只递增前面的数字，如01/12复制时变成02/12，03*12，04/12等，谢谢楼主的程序 [/B]

将主程序改为：

[PHP](defun c:cptxt( / ang dis en l loop n p1 p2 sn st)

(setq *error* nil)

(command "undo" "g")

(princ "\n欢迎使用文字或属性块连续增量拷贝程序! GYSJY  2008.12.16")

(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)(setq st (revstr st))

(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)(setq st (revstr st))(chtxt)

)

;(setq p2 nil)

)

)

(command "copy" sn "" p1 p2)

(setq sn (entlast) p1 p2 en (entget sn))

(tqwz)(setq st (revstr st))

(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 (revstr st2) st2 (tost2) st2 (revstr st2)

st (strcat st1 st2)

) ;按数字增长

)

);(princ st)(getstring)

(setq st (revstr st))

(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)

)

);修改属性

)

)

(defun revstr(st / l n st0 st1 st2);;将字符串倒序

(setq st1 "" st2 st l (strlen st) n l)

(repeat l

(setq st0 (substr st2 n) st2 (substr st 1 (1- n))

st1 (strcat st1 st0) n (strlen st2)

)

)st1

)

[/PHP]