增加AUTOCAD在文字處理上的功能

增加AUTOCAD在文字處理上的功能

一、說明
　　在用AUTOCAD制圖的過程中，必然要寫說明性文字。當然在制表和寫設計說明時，文字量就更大，AUTOCAD寫文字并無難處，難的是怎么使寫出的文字的尺寸、間距、對齊等方面象文字處理軟件那樣合適。若用AUTOCAD基本命令來處理，會很麻煩，并影響作圖速度。為此我編寫了一些小程序供大家使用。這次我提供如下兩個程序：
二、程序的安裝及使用
　　先把ZDDQ．LSP和ZDJT．LSP 拷貝到一個特定的目錄下(如:C:\R12\SUPPORT或C:\TCH\SYS等)。用戶可以將持到AUTOCAD或其它開發(fā)軟件的系統(tǒng)菜單上，通過菜單來調動，也可以AUTOCAD環(huán)境COMMAND后面用LOAD命令裝入，形成一個附加命令ZDDQ或ZDST。
　1．將程序調用裝入系統(tǒng)菜單
　　先找到菜單源文件ACAD.MNU，并編輯它。在* * * POP1最后加下面內(nèi)容。
　［字的對齊］^C^C^P(“ZDDQ”)；ZDDQ；^P。
　［字的間距調整］^C^C^P(LOAD“ZDJT”)；ZDJT；^P。用鼠標點取下拉菜單即可調用。
　2．命令調 用ZDDQ．LSP、ZDJT．LSP
　　在COMMAND后面輸入(LOAD“ZDDQ”)或(LOAD“ZDJT”)，產(chǎn)生可用命令ZDDQ、ZD JT，擊入命令按提示操作。
　3．兩程序在使用中基本為中文提示，易用，現(xiàn)已在我院網(wǎng)絡上全面使用。
　4．兩程序適用于AUTOCAD R10.0, R11,R12.0。
三、操作過程
　1．多文字對齊。提示如下：(其中“<>”中為缺省的選項)
選擇對齊方式如下：L左/R右/C中心/M中點：
選擇對齊方向如下：1橫向對齊(Y座標一致). 2縱向對齊(X座標一致) <2>:
點取對齊點<點取參照實體>：(即用鼠標在屏上點取對齊的位置，缺省后，提出讓你點取參照目標字，這樣后面選上的文字與對齊)
選取文字(自動濾非文字類實體，且不用考慮次序，開窗口選也可)。
　2．多文字的間距調整，提示如下：
　 　文字間距調整方式如下：
　　1. 水平 2. 垂直 3. 斜向 <1>：
　?、?若選“1”或缺省值，則
* 輸入各文字水平距值(或用鼠標點取)
* 選擇對齊方式：(C中心/L左側/R右側/H中心)
　　　1 若選“L”或缺省，則：
* 輸入這組文字起點。
* 按選后次序選取文字。
　　　2 其它類推。
　　? 選“2”，則：
* 輸入文字垂直間距值(或用鼠標點取)：
其它同①。
　　? 選“3”，則：
* 按先后次序選取文字。
* 點取斜線起點(即文字排列方向線)。
* 點取斜線終點。
　　(結果所選文字在斜線起點和終點間等分排列)。
四、源程序如下：
　　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$)
)