[LISP函数]：零件序列号代码

win_jeanne

文章来源：
中兴AutoCAD二次开发专业论坛（http://www.zx-home.com)

本人自己为了工作方便编了一个序列号标注的小程序，可能还有很多不足，一方面拿出来大家共享，另一方面请多提意见。
(defun c:xulie(/ xl)
(setq oldecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq oldsnap (getvar "osmode"))
(setvar "osmode" 0)
(setq oldortho (getvar "orthomode"))
(setvar "orthomode" 0)
(setq lay (getvar "clayer"))
(setq xl (ssget "X"
(list
;(-4."<AND")
(cons 8 "11")
(cons 0 "TEXT")
;(-4."AND>")
)
)
)
(if (= xl nil)
(txn)
(progn
(setq str (atoi(getstring "\n插入序号请输入(1)继续标注请输入(2):")))
(if (= str 1)
(txnn)
(txn)
)
)
)
)

(defun txn()
(setq bl (/ (getvar "ltscale") 10))
(setq dqfs (getint "\n请选择对齐方式(纵向<1>横向<0>)默认<0>:"))
(setq dpoint (getpoint "\n请选择对齐点:"))
(princ "\n请输入编码起始值<")
(if tx
(princ tx)
(progn
(setq tx 1)
(princ tx)
)
)
(setq tx_ent (getint ">:"))

(if tx_ent
(setq tx tx_ent)
)
(setq sel_pnt "t")
(while sel_pnt
(princ "\n请输入序列号<")
(princ tx)
(setq p1 (getpoint ">的标注起始点:"))
(princ "\n请输入序列号<")
(princ tx)
(setq p2 (getpoint p1 ">的标注转折点:"))
(if (= dqfs 1)
(setq p2 (list (car dpoint) (cadr p2)))
(setq p2 (list (car p2) (cadr dpoint)))
)
(setvar "osmode" 0)
(cond
((< (car p1) (car p2))
(setvar "clayer" "08")
(command "line" p1 p2 "")
(setq p3 (polar p2 0 (* 6 bl)))
(command"line" p2 p3 "")
(setq p4_x (+ (car p2) (* 3 bl)))
(setq p4_y (+ (cadr p2) (* 4 bl)))
(setq p4 (list p4_x p4_y))
(setvar "clayer" "11")
(command "text" "m" p4 (* 5 bl) "" tx(terpri)(terpri)(terpri))
(setq tx (1+ tx))
)
)
(cond
((> (car p1) (car p2))
(setvar "clayer" "08")
(command "line" p1 p2 "")
(setq p3 (polar p2 (angtof "180") (* 6 bl)))
(command"line" p2 p3 "")
(setq p4_x (- (car p2) (* 3 bl)))
(setq p4_y (+ (cadr p2) (* 4 bl)))
(setq p4 (list p4_x p4_y))
(setvar "clayer" "11")
(command "text" "m" p4 (* 5 bl) "" tx(terpri)(terpri)(terpri))
(setvar "clayer" lay)
(setq tx (1+ tx))
)
)

)
)
(defun txnn()
(setq lay (getvar "clayer"))
(setq tx (getint"\n请输入插入序号:"))
(princ "\n请输入插入序号")
(princ tx)
(setq p1 (getpoint "的标注起始点:"))
(princ "\n请输入插入序号")
(princ tx)
(setq p2 (getpoint p1 "的标注转折点:"))
(setvar "osmode" 0)
(cond
((< (car p1) (car p2))
(setvar "clayer" "08")
(command "line" p1 p2 "")
(setq p3 (polar p2 0 (* 6 bl)))
(command"line" p2 p3 "")
(setq p4_x (+ (car p2) (* 3 bl)))
(setq p4_y (+ (cadr p2) (* 4 bl)))
(setq p4 (list p4_x p4_y))
(setvar "clayer" "11")
(command "text" "m" p4 (* 5 bl) "" tx(terpri)(terpri)(terpri))
(setq tx (1+ tx))
)
)
(cond
((> (car p1) (car p2))
(setvar "clayer" "08")
(command "line" p1 p2 "")
(setq p3 (polar p2 (angtof "180") (* 6 bl)))
(command"line" p2 p3 "")
(setq p4_x (- (car p2) (* 3 bl)))
(setq p4_y (+ (cadr p2) (* 4 bl)))
(setq p4 (list p4_x p4_y))
(setvar "clayer" "11")
(command "text" "m" p4 (* 5 bl) "" tx(terpri)(terpri)(terpri))
(setvar "clayer" lay)
(setq tx (1+ tx))
)
)
(setq tx2 (entlast))
(setq ename2 (entget tx2))
(setq tx3 (cdr(assoc 1 ename2)))
(setq tx4 (atoi tx3))
(setq ss 0)
(setq jh (ssname xl ss))
(setq ename (entget jh))
(setq tx1 (cdr(assoc 1 ename)))
(setq tx1 (atoi tx1))
(setq ename1 tx1)
(while tx1
(if (<= tx4 tx1)
(progn
(setq ename (subst (cons 1 (itoa(+ tx1 1))) (assoc 1 ename) ename))
(entmod ename)
)
)
(setq tx1 nil)
(while (= nil tx1)
(setq ss (1+ ss))
(setq ename1 (ssname xl ss))
(setq ename (entget ename1))
(setq tx1 (atoi(cdr(assoc 1 ename))))

)

)
(setq xl nil)
)

本人自己为了工作方便编了一个序列号标注的小程序，可能还有很多不足，一方面拿出来大家共享，另一方面请多提意见。
(defun c:xulie(/ xl)
(setq oldecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq oldsnap (getvar "osmode"))
(setvar "osmode" 0)
(setq oldortho (getvar "orthomode"))
(setvar "orthomode" 0)
(setq lay (getvar "clayer"))
(setq xl (ssget "X"
(list
;(-4."<AND")
(cons 8 "11")
(cons 0 "TEXT")
;(-4."AND>")
)
)
)
(if (= xl nil)
(txn)
(progn
(setq str (atoi(getstring "\n插入序号请输入(1)继续标注请输入(2):")))
(if (= str 1)
(txnn)
(txn)
)
)
)
)

(defun txn()
(setq bl (/ (getvar "ltscale") 10))
(setq dqfs (getint "\n请选择对齐方式(纵向<1>横向<0>)默认<0>:"))
(setq dpoint (getpoint "\n请选择对齐点:"))
(princ "\n请输入编码起始值<")
(if tx
(princ tx)
(progn
(setq tx 1)
(princ tx)
)
)
(setq tx_ent (getint ">:"))

(if tx_ent
(setq tx tx_ent)
)
(setq sel_pnt "t")
(while sel_pnt
(princ "\n请输入序列号<")
(princ tx)
(setq p1 (getpoint ">的标注起始点:"))
(princ "\n请输入序列号<")
(princ tx)
(setq p2 (getpoint p1 ">的标注转折点:"))
(if (= dqfs 1)
(setq p2 (list (car dpoint) (cadr p2)))
(setq p2 (list (car p2) (cadr dpoint)))
)
(setvar "osmode" 0)
(cond
((< (car p1) (car p2))
(setvar "clayer" "08")
(command "line" p1 p2 "")
(setq p3 (polar p2 0 (* 6 bl)))
(command"line" p2 p3 "")
(setq p4_x (+ (car p2) (* 3 bl)))
(setq p4_y (+ (cadr p2) (* 4 bl)))
(setq p4 (list p4_x p4_y))
(setvar "clayer" "11")
(command "text" "m" p4 (* 5 bl) "" tx(terpri)(terpri)(terpri))
(setq tx (1+ tx))
)
)
(cond
((> (car p1) (car p2))
(setvar "clayer" "08")
(command "line" p1 p2 "")
(setq p3 (polar p2 (angtof "180") (* 6 bl)))
(command"line" p2 p3 "")
(setq p4_x (- (car p2) (* 3 bl)))
(setq p4_y (+ (cadr p2) (* 4 bl)))
(setq p4 (list p4_x p4_y))
(setvar "clayer" "11")
(command "text" "m" p4 (* 5 bl) "" tx(terpri)(terpri)(terpri))
(setvar "clayer" lay)
(setq tx (1+ tx))
)
)

)
)
(defun txnn()
(setq lay (getvar "clayer"))
(setq tx (getint"\n请输入插入序号:"))
(princ "\n请输入插入序号")
(princ tx)
(setq p1 (getpoint "的标注起始点:"))
(princ "\n请输入插入序号")
(princ tx)
(setq p2 (getpoint p1 "的标注转折点:"))
(setvar "osmode" 0)
(cond
((< (car p1) (car p2))
(setvar "clayer" "08")
(command "line" p1 p2 "")
(setq p3 (polar p2 0 (* 6 bl)))
(command"line" p2 p3 "")
(setq p4_x (+ (car p2) (* 3 bl)))
(setq p4_y (+ (cadr p2) (* 4 bl)))
(setq p4 (list p4_x p4_y))
(setvar "clayer" "11")
(command "text" "m" p4 (* 5 bl) "" tx(terpri)(terpri)(terpri))
(setq tx (1+ tx))
)
)
(cond
((> (car p1) (car p2))
(setvar "clayer" "08")
(command "line" p1 p2 "")
(setq p3 (polar p2 (angtof "180") (* 6 bl)))
(command"line" p2 p3 "")
(setq p4_x (- (car p2) (* 3 bl)))
(setq p4_y (+ (cadr p2) (* 4 bl)))
(setq p4 (list p4_x p4_y))
(setvar "clayer" "11")
(command "text" "m" p4 (* 5 bl) "" tx(terpri)(terpri)(terpri))
(setvar "clayer" lay)
(setq tx (1+ tx))
)
)
(setq tx2 (entlast))
(setq ename2 (entget tx2))
(setq tx3 (cdr(assoc 1 ename2)))
(setq tx4 (atoi tx3))
(setq ss 0)
(setq jh (ssname xl ss))
(setq ename (entget jh))
(setq tx1 (cdr(assoc 1 ename)))
(setq tx1 (atoi tx1))
(setq ename1 tx1)
(while tx1
(if (<= tx4 tx1)
(progn
(setq ename (subst (cons 1 (itoa(+ tx1 1))) (assoc 1 ename) ename))
(entmod ename)
)
)
(setq tx1 nil)
(while (= nil tx1)
(setq ss (1+ ss))
(setq ename1 (ssname xl ss))
(setq ename (entget ename1))
(setq tx1 (atoi(cdr(assoc 1 ename))))

)

)
(setq xl nil)
)

qjcpj

回1楼：
1. 可考虑使用DCL添加对话框，很方便的！
2. 考虑定义一个“图形比例”变量，在不同比例时可自动更改字高等变量。
3. 程序中的变量应使用局部变量...etc
   仅供你修改程序时参考！