！！！！cad二次开发专贴

文字对齐的程序
(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




)

模板自动生成配筋图
(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)
)