四、源程序如下：
1．多文字的对齐：
;--------------------
; 1996.03.04
;
(defun c:zddq ( / i n txsize ent ent1 o1 o2 o3 o4 a aa oldsiaze newsize
index bb cc p0 p1 p pp ent0 b ss a1 a2 a3 a4 a5 a6)
(setq i 1)
(princ "\n")(princ "选择对齐方式如下:")(princ)
(setq a (getstring "\n L左/R右/C中心/M中点 < L >: "))
(if (= a "")(setq a "L"))
(setq a (strcase a))
(cond ((= a "L")(setq a1 0 a2 11 a4 10 a5 10))
((= a "M")(setq a1 1 a2 10 a4 11 a5 11))
((= a "R")(setq a1 2 a2 10 a4 11 a5 11))
((= a "C")(setq a1 4 a2 10 a4 11 a5 11))
)
(setq b (getint "\n1.横向对齐(使Y座标一样) 2. 纵向对齐(使X座标一样) <2>: "))
(setq txsize (getpoint "\n点取对齐点<点取参照实体>: "))
(princ "\n")(princ "选取文字(自动滤去非文字实体):")(princ)
(while (< i 10000)
(setq ss (ssget))
(setq n (sslength ss))
(setq index 0)
(repeat n
(setq ent0 (entget (ssname ss index)))
(if (= (cdr (assoc 72 ent0)) 0)
(progn
(setq a4 10)
(if (/ = a1 0)(setq a5 11)(setq a5 10))
)
)
(setq index (+ 1 index))
(setq type (assoc 0 ent0))
(if (= "TEXT" (cdr type))
(progn
(setq p0 (assoc 72 ent0))
(setq p (cons (car p0) a1))
(setq pp (subst p p0 ent0))
(setq old (assoc 11 pp))
(if (= a "L")
(setq a3 (list 0 0))
(setq a3 (cdr (assoc 11 pp)))
)
(setq new (cons (car old) a3))
(setq ent (subst new old pp))
(setq o1 (cadr (cdr (assoc a4 ent0))))
(setq o2 (car (cdr (assoc a4 ent0))))
(if (= txsize nil)
(p rogn
(setq a6 (entget (ssname ss 0)))
(setq a6 (cdr (assoc a4 a6)))
(setq o3 (car a6) o4 (cadr a6))
)
(setq o3 (car txsize) o4 (cadr txsize))
)
(setq oldsize (assoc a5 ent0))
(if (and (/= b nil)(/= b 2))
(setq aa o2 bb o4 cc (car oldize))
(setq aa o3 bb o1 cc (cdr oldsize))
)
(setq newsize (cons (car oldsize) (list aa bb)))
(setq ent1 (subst newsize oldsize ent))
(entmod ent1)
)
)
)
)
(prin1)
)
;--------------------
2．多文字的间距调整
edit date: 1995.6.1
(defun c:zd jt ( / new old ent ent1 index s ss s1 s2 cj sj n x xs y ys wb wg wc wg0 wg1 zb type fs i j bbb bj1 bj2 aj1 aj2 cj1 cj2 $a $c $b ss1 ss2 dj1 dj2 zx ej1 ej2 fj1 fj2 zk jd)
(setvar "cmdecho" 0)
; (princ "\n1. order: from top to button. from left to right")
; (princ "\n2. there is over a entity")(princ)
(princ "\n间距调整方式选择如下:")(princ)
(setq sj nil cj nil)
(setq s1 (getint "\n 1.水平 2.垂直 3.斜向 <1>: "))
(if (/ = s1 3)
(progn
(if (= s1 nil)(setq s1 1))
(if (= s1 1) (setq sj (getdist "\n输入文字水平间距值(或用鼠标点取):"))
(setq cj (getdist "\n输入文字垂直间距值(或用鼠标点取):")))
(setq fs (strcase (getstring "\n选择对齐方式(C中心/L左侧/R右侧/M中点) < L >: ")))
(if (= fs "M")(progn
(command "osnap" "nea")
(setq ss1 (getpoint "\n文字起点: "))
(setq ss2 (getcorner ss1 "\n文字终点: "))
(setq s2 (polar ss1 (angle ss1 ss2) (/ (distance ss1 ss2) 2)))
(command "osnap" "none")
)
(setq s2 (getpoint "\n这组文字起点text location point:"))
)
(setq x (car s2) y (cadr s2))
(princ "\n按先后次序选取文字")(princ)
(setq ss (ssget))
(setq n (sslength ss) index 0 i 0 j 0)
(rep eat n
(setq ent (entget (ssname ss index)))
(if (= "TEXT" (cdr (assoc 0 ent)))
(pr ogn
(setq i (+ i 1))
( if (= s1 1)
(setq zb (car (CDR (assoc 10 (entget (ssname ss index))))))
(setq zb (CADR (cdr (assoc 10 (entget (ssname ss index))))))
)
(set q wb (cdr (assoc 1 (entget (ssname ss index))))
wg (cdr (assoc 40 (entget (ssname ss index))))
zk (cdr (assoc 41 (entget (ssname ss index))))
jd (cdr (assoc 50 (entget (ssname ss index))))
zx (cdr (assoc 7 (entget (ssname ss index))))
)
(set (read (strcat "b" (itoa i))) zb);coordinate
(set (read (strcat "a" (itoa i))) wb);word
(set (read (strcat "c" (itoa i))) wg);hight
(set (read (strcat "d" (itoa i))) zx);word style
(set (read (strcat "e" (itoa i))) zk);word wide
(set (read (strcat "f" (itoa i))) jd);word engle
(setq new (cons (car (assoc 1 ent)) " "))
(setq ent1 (subst new (assoc 1 ent) ent))
(entmod ent1)
)
)
(setq index (+ index 1))
)
(setq n i)
(while (>= n 2)
(setq j 1)
(wh ile (<= j (- n 1))
(setq bj1 (eval (read (strcat "b" (itoa j)))))
(setq bj2 (eval (read (strcat "b" (itoa (+ j 1))))))
(setq aj1 (eval (read (strcat "a" (itoa j)))))
(setq aj2 (eval (read (strcat "a" (itoa (+ j 1))))))
(setq cj1 (eval (read (strcat "c" (itoa j)))))
(setq cj2 (eval (read (strcat "c" (itoa (+ j 1))))))
(setq dj1 (eval (read (strcat "d" (itoa j)))))
(setq dj2 (eval (read (strcat "d" (itoa (+ j 1))))))
(setq ej1 (eval (read (strcat "e" (itoa j)))))
(setq ej2 (eval (read (strcat "e" (itoa (+ j 1))))))
(setq fj1 (eval (read (strcat "f" (itoa j)))))
(setq fj2 (eval (read (strcat "f" (itoa (+ j 1))))))
; (if (/= s1 1)(setq bbb bj1 bj1 bj2 bj2 bbb));-----------------
(if (AND (= S1 1)(> bj1 bj2))(BBBB))
(if (AND (= S1 2)(< bj1 bj2))(BBBB))
(setq j (+ j 1))
)
(setq n (- n 1))
)
(setq n 0)
(re peat i
(setq n (+ n 1))
(setq wg (eval (read (strcat "c" (itoa n)))))
(setq wb (eval (read (strcat "a" (itoa n)))))
(setq zx (eval (read (strcat "d" (itoa n)))))
(setq zk (eval (read (strcat "e" (itoa n)))))
(setq jd (eval (read (strcat "f" (itoa n)))))
(setq zk2 (cdr (assoc 41 (tblsearch "style" zx)))
zt (cdr (assoc 3 (tblsearch "style" zx)))
zt2 (cdr (assoc 4 (tblsearch "style" zx)))
)
(if (/= zk zk2)
(if (= (strcase zx) "STANDARD")
(command "style" zx "" "0" zk "0" "n" "n" "n")
(command "style" zx "" "0" zk "0" "n" "n")
)
)
(if (= s1 1)(progn
(setq xs (+ x (* sj (- n 1))))
(setq zb (list xs y))
( if (= fs "")
( if (> (cdr (assoc 40 (tblsearch "style" zx))) 0.00001)
(command "text" zb (/ (* jd 180.0) pi) wb)
(command "text" zb wg (/ (* jd 180.0) pi) wb)
)
(if (> (cdr (assoc 40 (tblsearch "style" zx))) 0.00001)
(command "text" fs zb (/ (* jd 180.0) pi) wb)
[KG*2](command "text" fs zb wg (/ (* jd 180.0) pi) wb)
)
)
)
(p rogn
(setq ys (- y (* cj (- n 1))))
(setq zb (list x ys))
( if (= fs "")
( if (> (cdr (assoc 40 (tblsearch "style" zx))) 0.00001)
(command "text" zb (/ (* jd 180.0) pi) wb)
(command "text" zb wg (/ (* jd 180.0) pi) wb)
)
(if (> (cdr (assoc 40 (tblsearch "style" zx))) 0.00001)
(command "text" fs zb (/ (* jd 180.0) pi) wb)
(command "text" fs zb wg (/ (* jd 180.0) pi) wb)
)
)
)
)
)
)
(progn
(princ "\n按先后次序选取文字")(princ)
(setq ss (ssget) cd (sslength ss))
(princ "\n按选取文字先后次序,从斜线起点至终点等分这组文字")(princ)
(setq qd (getpoint "\n斜线起点: "))
(setq zd (getpoint qd "\n斜线终点: "))
(setq jd (angle qd zd))
(setq jl (distance qd zd) jl (/ jl (- cd 1)))
(setq i 0)
(repeat cd
(setq zd (polar qd jd (* i jl)))
(setq wg (cdr (assoc 40 (entget (ssname ss i)))))
(setq wb (cdr (assoc 1 (entget (ssname ss i)))))
(command "text" zd wg "0" wb)
(setq i (1+ i))
)
)
)
)
(DEFUN BBBB ()
(setq b$ bj1 a$ aj1 c$ cj1)
(set (read (strcat "b" (itoa j))) bj2)
(set (read (strcat "a" (itoa j))) aj2)
(set (read (strcat "c" (itoa j))) cj2)
(set (read (strcat "b" (itoa (+ j 1)))) b$)
(set (read (strcat "a" (itoa (+ j 1)))) a$)
(set (read (strcat "c" (itoa (+ j 1)))) c$)
)
