建议最好为源码，说明功能，以便修改
z坐标归0

功能：将三维线转为二维，解决直线不共面的问题
(defun c:z0()
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(graphscr)
(prompt "Z向归零:") (terpri)

(princ "请选择要归零的实体")
(setq s (ssget))
(setq len (sslength s))
(setq index 0)

(repeat len
(setq a (entget (ssname s index)))

(setq b10 (assoc 10 a))
(setq b11 (assoc 11 a))

(setq x10 (cadr b10))
(setq y10 (caddr b10))

(setq x11 (cadr b11))
(setq y11 (caddr b11))

(setq b101 (cons 10 (list x10 y10 0)))
(setq b111 (cons 11 (list x11 y11 0)))

(setq a (subst b101 b10 a))
(entmod a)
(setq a (subst b111 b11 a))
(entmod a)

(setq index (+ index 1))
)
(princ "成功")
(princ)
)

说明一下，这些程序都是以前搜集的，如有侵犯哪位兄弟的利益，敬请告知我会及时删除
写图签日期程序
(defun c:rq(/ entn entl text high)
(setq entn (car (entsel "选择加年月日的文字")))
(setq entl (entget entn))
(setq ti (rtos (getvar "cdate") 2 6))
(setq yy (substr ti 1 4))
(setq mm (substr ti 5 2))
(setq mm (atoi mm))
(setq mm (itoa mm))
(setq dd (substr ti 7 2))
(setq dd (atoi dd))
(setq dd (itoa dd))
(setq text (strcat yy "." mm "." dd))
(setq entl (subst (cons 1 text) (assoc 1 entl) entl))
(entmod entl)
(princ)
)

画图画得晕乎乎的时候不用去想日期，呵呵

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; rq.lsp 写日期
(DEFUN C:RQ (/ tmp y m d txt pt1)
(@cmdla0)
(setq tmp (rtos (getvar "cdate") 2 8)
y (substr tmp 1 4)
m (substr tmp 5 2)
d (substr tmp 7 2)
t1 (strcat y " " m " " d)
t2 (strcat y "年" m "月" d "日")
)
(while (setq pt1 (getpoint "\n\t起点："))
(setq txt6
(@ukword
1
"A B C D E"
"\n请选择处理方式：A-年月日/B-年/C-月/D-日/E-2004年11月18日"
txt6
)
)
(command "text"
"j"
"ml"
pt1
"350"
"0"
(cond
((= txt6 "A") t1)
((= txt6 "B") y)
((= txt6 "C") m)
((= txt6 "D") d)
((= txt6 "E") t2)
)
)
)
(@cmdla1)
)
(defun @CMDLA0 ()
(setq cmdech (getvar "CMDECHO"))
(setq oom (getvar "orthomode"))
(setq osm (getvar "osmode"))
(SETQ LA (getvar "clayer"))
(setq rmode (getvar "regenmode"))
(setq pw (getvar "plinewid"))
(setvar "regenmode" 0)
(setvar "CMDECHO" 0)
(princ)
)

(defun @CMDLA1 ()
(setvar "CMDECHO" cmdech)
(setvar "orthomode" oom)
(setvar "osmode" osm)
(setvar "clayer" LA)
(setvar "regenmode" rmode)
(setvar "plinewid" pw)
(princ)
)

(defun @ukword (bit kwd msg def / inp)
(if (and def (/= def ""))
(setq msg (strcat "\n" msg "<" def ">:")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ":"))
)
(initget bit kwd)
(setq inp (getkword msg))
(if inp
inp
def
)
)
(DEFUN PXYP (TXT1)
(SETQ TXT1 (STRCAT "\n\r 程序命令: "
TXT1
" -- xyp@bsedi.com"
)
)
(PRINC TXT1)
(Princ)
)
(pxyp "RQ (日期)")
(princ)



偶也写了一个插入当前日期的程序，请各位高手指正
(defun c:rq (/ osm tmp y m d ymd tt t1 y1 y2 y3 pt1)
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(setq tmp (rtos (getvar "cdate") 2 8))
(setq y (substr tmp 1 4)
m (substr tmp 5 2)
d (substr tmp 7 2)
)
(setq ymd (strcat y "." m "." d))
(setq tt (entsel "\n请选择参照目标"))
(setq pt1 (getpoint "\n请选择文字插入点："))
(setq t1 (entget (car tt)))
(if (/= (cdr (assoc 0 t1)) "TEXT")
(princ "\n目标选择错误，请重新选择。")
(progn
(setq y1 (cdr (assoc 7 t1))
y2
(cdr (assoc 40 t1))
y3
(cdr (assoc 50 t1))
)
(setq y3 (/ (* y3 180) pi))
(command "text" "s" y1 pt1 y2 y3 ymd)
)
)
(setvar "osmode" osm)
)


“年月日时分秒”更简单的获取方式：
(menucmd "M=$(edtime,$(getvar,date),YYYY年M月D日hh时mm分ss秒)")

测试结果："2005年1月30日13时53分42秒"

3位小数变两位
(defun c:t1(/ ss ssl i el str)
(if (setq ss (ssget ’((0 . "Text"))));_ Only number text
(progn
(setq ssl (sslength ss)
i -1
)
(repeat ssl
(setq el (entget (ssname ss (setq i (1+ i))))
str (cdr (assoc 1 el))
)
(entmod (subst (cons 1 (rtos (atof str) 2 2))
(assoc 1 el)
el
)
)
)
)
)
(princ)
)

模板自动生成配筋图
(defun c:ttt( / ang get-points dis dis0 e0 e1 e2 e2n j li-po line->every
os p1 p2 p3 p4 p5 p6 pt sca ss isclose _isinside)
(defun _isinside(pt pt0 li-po / j pt1 px py)
(setq px(car li-po)li-po(cdr li-po) j 0)
(while li-po
(setq py(car li-po) li-po(cdr li-po))
(if(setq pt1(inters pt pt0 px py))
(if(or(equal(distance pt1 px)1e-3)(equal(distance pt1 py)1e-3))
(setq j(+ j 0.5))
(setq j(1+ j))
)
)
(setq px py)
)
(cond ((=(rem j 2)0) t)
((=(rem j 2)1) nil)
)
)
(defun line->every (pts / pt1 ss1 )
(setq ss1(ssadd)pt1(car pts)pts(cdr pts))
(foreach pt2 pts
(entmake
(list ’(0 . "LINE")’(100 . "AcDbEntity")’(100 . "AcDbLine")(cons 10 pt1)(cons 11 pt2)))
(ssadd (entlast) ss1)
(setq pt1 pt2)
) ss1
)
(defun get-points(pl / j obj pt pts)
(setq obj (vlax-ename->vla-object pl)
j 0
isclose(vlax-curve-isClosed obj))
(while(setq pt(vlax-curve-getPointAtParam obj j))(setq pts(cons pt pts)j(1+ j)))
(if isclose(reverse pts)
(reverse(cons(last pts)pts))
)
)
(if (not MYscale)(or(setq MYscale(getint "\n比例1:(100) "))(setq MYscale 100)))
(setq j 0
os (getvar"osmode")
pt t
e0 (entlast)
)
(command"undo""begin")
(while (and(progn (initget "s")t)
(setq pt(getpoint"\n在里面点一下[S比例]:"))
)
(cond((= pt "S")
(if(setq sca(getint(strcat"\n比例1:("(atoi myscale)"): ")))(setq MYscale sca))
)
((listp pt)
(if(and
(progn(command"-boundary""a""o""p"""pt"")
(setq e1(entlast))
(not(equal e0 e1))
)
(progn(setq dis(getdist"\n输入出头距离(200):"))
(if(not dis)(setq dis 200) t)
)
(setvar "offsetdist"(* 1.2 myscale))
(progn(command".offset""" e1 pt "") t)
(setq li-po(get-points (entlast)))
(entdel e1)(entdel(entlast))
(setq ss (line->every li-po))
)
(repeat(sslength ss)
(setq e2 (ssname ss j)
e2n (entget e2)
p1 (cdr(assoc 10 e2n))
p2 (cdr(assoc 11 e2n))
ang (angle p1 p2)
dis0 (distance p1 p2)
)
(setq p3(polar p2 ang dis))
(if(_isinside p3 pt li-po )
(progn(entmod(subst(cons 11 p3)(assoc 11 e2n)e2n))(setq p2 p3))
)
(setq p3(polar p1 (+ pi ang) dis))
(if(_isinside p3 pt li-po)
(progn (entmod(subst(cons 10 p3)(assoc 10 e2n)e2n))(setq p1 p3))
)
(setq p3(mapcar ’(lambda(x y)(/(+ x y)2.)) p1 p2)
p4(polar p3(+ ang(/ pi 2.))(* myscale 0.9))
p5(polar p3(- ang(/ pi 2.))(* myscale 0.9))
p6(if(_isinside p4 pt li-po)p4 p5)
)
(if(> dis0 (* 2 dis))
(progn
(setvar "osmode" 0)
(command"donut""0"(* myscale 0.6) p6(polar p6 ang dis)(polar p6(+ ang pi)dis)"")
(setvar "osmode" os)
))
(command"pedit" e2 "y""w"(* 0.45 myscale)"")
(setq j(1+ j))
)
))))
(command"undo""end")
(princ)
)

文字对齐的程序
(progn
(setq ifhv nil)
(setq soname nil)
(setq lsoname nil)
(setq xyzsoname nil)
(setq ysoname nil)
(setq xsoname nil)
(setq fx nil fy nil fz nil)
(setq fysoname nil)
(setq fxyzsoname nil flsoname nil)
(setq fsname nil)
(setq lfxyz nil)
(setq flsoname nil)
(setq sobjectx nil)

(setvar "cmdecho" 0)
);;end progn
(defun C:tt1 ( )

(setq ifhv (getstring "please input Horiz or Vertical (H/):"))

(if (or (= ifhv "h") (= ifhv "H"))
(progn
(prompt "please select a soure text for align:")
(setq sobjectx (ssget))
(setq soname (ssname sobjectx 0))
(setq lsoname (entget soname))
(setq xyzsoname (assoc ’10 lsoname))
(setq ysoname (caddr xyzsoname))

;;(print ysoname)
;;(print soname)

(prompt "please select aligned text:")
(setq i 0)
(setq ent (ssget ’((0 . "TEXT"))))
(setq l (sslength ent))
(while (< i l)
(progn
(setq fsname (ssname ent i))
(setq flsoname (entget fsname))
(setq fxyzsoname (assoc ’10 flsoname))
(setq fx (cadr fxyzsoname))
(setq fz (caddr fxyzsoname))
(setq lfxyz (list 10 fx ysoname fz))
(setq flsoname (subst lfxyz (assoc 10 flsoname) flsoname))
;;(print fx)
;;(print fz)
;;(print lfxyz)
;; (print flsoname)
(entmod flsoname)
(entupd fsname)
(setq i (1+ i))
)
)
(setq i nil)
(setq ent nil)
(setq l nil)
(princ) ; Exit quietly.

);end progn
);end if

;;;;;;;;;;;;;;;;;;;;;;;;X align
(progn

(prompt "please select a soure text for align:")
(setq sobjectx (ssget))
(setq soname (ssname sobjectx 0))
(setq lsoname (entget soname))
(setq xyzsoname (assoc ’10 lsoname))
(setq xsoname (cadr xyzsoname))

(prompt "please select aligned text:")
(setq i 0)
(setq ent (ssget ’((0 . "TEXT"))))
(setq l (sslength ent))
(while (< i l)
(progn
(setq fsname (ssname ent i))
(setq flsoname (entget fsname))
(setq fxyzsoname (assoc ’10 flsoname))
(setq fy (caddr fxyzsoname))
(setq fz (cadddr fxyzsoname))
(setq lfxyz (list 10 xsoname fy fz))
(setq flsoname (subst lfxyz (assoc 10 flsoname) flsoname))
;;(print fx)
;;(print fz)
;;(print lfxyz)
;; (print flsoname)
(entmod flsoname)
(entupd fsname)
(setq i (1+ i))
)
)
(setq i nil)
(setq ent nil)
(setq l nil)
(princ) ; Exit quietly.



);end progn




)