等老大出招,,,,,希望不要太复杂... (defun c:nn( / asc e1 e2 en en1 k l loop p p1 p2 sn sn1 st st1 st2)
(setq *error* nil)
(command "undo" "g")
(princ "\n欢迎使用文字或属性块连续增量拷贝程序! GYSJY2008.12.16")
(if (setq sn (entsel "\n点取物体:"))
(progn
(setq p1 (cadr sn) 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
(setq p2 (getpoint "\n下一点:" p1))
(command "copy" sn "" p1 p2)
(setq sn (entlast) p1 p2 en (entget sn))
(tqwz);(princ st)(getstring)
(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)
)
);修改属性
)
(princ st)
)
)
(princ "\n ***你所点取的图元不是属性块或文字!本程序只拷贝带属性的块或文字。***")
)
)
)
(command "undo" "e")
(princ)
)
(defun to(n)
(cdr (assoc n (entget sn)))
)
(defun nextstr()
(setq sn1(entnext sn1)
s (entget (entnext (cdr (car (entget sn1)))))
str1 (cdr (assoc 1 s))
)
str1
)
谁可以帮我把GYSJY编的这个程序改下。现在复制如0042A(5)-PB01，被改成0043了。而不是我想要的0042A(5)-PB02、0042A(5)-PB03这样的。 本帖最后由 e2002 于 2011-1-13 11:36 编辑
回复 masterlong 的帖子
这一直就是个问题， 所以 Autodesk 弄出了Sheetset 来解决，不过还是太复杂，估计会的没几个，现实情况是简单的 Layout 会的都可能不到10%吧？ 这个问题好像没有被解决啊~~~~~~~！ 发帖才能看。。。。多发几个
页:
1
[2]