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

frogfish

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

　　一、说明

　　在用AUTOCAD制图的过程中，必然要写说明性文字。当然在制表和写设计说明时，文字量就更大，AUTOCAD写文字并无难处，难的是怎么使写出的文字的尺寸、间距、对齐等方面象文字处理软件那样合适。若用AUTOCAD基本命令来处理，会很麻烦，并影响作图速度。为此我编写了一些小程序供大家使用。这次我提供如下两个程序：

　　二、程序的安装及使用

　　先把ZDDQ.LSP和ZDJT.LSP 拷贝到一个特定的目录下(如:C:\R12\SUPPORT或C:\TCH\SYS等)。用户可以将持到AUTOCAD或其它开发软件的系统菜单上，通过菜单来调动，也可以AUTOCAD环境COMMAND后面用LOAD命令装入，形成一个附加命令ZDDQ或ZDST。

　　1.将程序调用装入系统菜单

　　先找到菜单源文件ACAD.MNU，并编辑它。在* * * POP1最后加下面内容。

　　[字的对齐]^C^C^P(“ZDDQ”);ZDDQ;^P。

　　[字的间距调整]^C^C^P(LOAD“ZDJT”);ZDJT;^P。用鼠标点取下拉菜单即可调用。

　　2.命令调 用ZDDQ.LSP、ZDJT.LSP

　　在COMMAND后面输入(LOAD“ZDDQ”)或(LOAD“ZDJT”)，产生可用命令ZDDQ、ZD JT，击入命令按提示操作。

　　3.两程序在使用中基本为中文提示，易用，现已在我院网络上全面使用。

　　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")

　　)

frogfish

　　(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 bbj1abj1a aj1 ccj1)

　　(set(read(strcat"b"(itoaj)))bj2)

　　(set(read(strcat"a"(itoaj)))aj2)

　　(set(read(strcat"c"(itoaj)))cj2)

　　(set(read(strcat"b"(itoa(+j1))))bcj1)

　　(set(read(strcat"b"(itoaj)))bj2)

　　(set(read(strcat"a"(itoaj)))aj2)

　　(set(read(strcat"c"(itoaj)))cj2)

　　(set(read(strcat"b"(itoa(+j1))))b)

　　(set (read (strcat "a" (itoa (+ j 1)))) a)

　　(set(read(strcat"c"(itoa(+j1))))c)

　　(set(read(strcat"c"(itoa(+j1))))c)

　　)

vibra

下了
谢谢

kingflying

哇，现在都不大看得懂这些LISP了，呵呵

shilw

呵呵，前段看vba的说上有个类似的，还不错

zgzzsn

楼主功底很厚。我回去试试。