声振论坛

 找回密码
 我要加入

QQ登录

只需一步,快速开始

查看: 2045|回复: 0

[AutoCAD] 增加AUTOCAD在文字处理上的功能(转贴)

[复制链接]
发表于 2007-5-30 16:10 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?我要加入

x
一、说明

  在用AUTOCAD制图的过程中,必然要写说明性文字。当然在制表和写设计说明时,文字量就更大,AUTOCAD写文字并无难处,难的是怎么使写出的文字的尺寸、间距、对齐等方面象文字处理软件那样合适。若用AUTOCAD基本命令来处理,会很麻烦,并影响作图速度。为此我编写了一些小程序供大家使用。这次我提供如下两个程序:
二、程序的安装及使用
  先把ZDDQLSPZDJTLSP 拷贝到一个特定的目录下(:C:\R12\SUPPORTC:\TCH\SYS)。用户可以将持到AUTOCAD或其它开发软件的系统菜单上,通过菜单来调动,也可以AUTOCAD环境COMMAND后面用LOAD命令装入,形成一个附加命令ZDDQZDST

1.将程序调用装入系统菜单
  先找到菜单源文件ACAD.MNU,并编辑它。在* * * POP1最后加下面内容。
 [字的对齐]^C^C^P(“ZDDQ”)ZDDQ^P
 [字的间距调整]^C^C^P(LOAD“ZDJT”)ZDJT^P。用鼠标点取下拉菜单即可调用。


2.命令调 ZDDQLSPZDJTLSP
  在COMMAND后面输入(LOAD“ZDDQ”)(LOAD“ZDJT”),产生可用命令ZDDQZD JT,击入命令按提示操作。

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


4.两程序适用于AUTOCAD R10.0, R11,R12.0

三、操作过程

1.多文字对齐。提示如下:(其中“<>”中为缺省的选项)
选择对齐方式如下:L/R/C中心/M中点<L>

选择对齐方向如下:1横向对齐(Y座标一致). 2纵向对齐(X座标一致) <2>:
点取对齐点<点取参照实体>(即用鼠标在屏上点取对齐的位置,缺省后,提出让你点取参照目标字,这样后面选上的文字与对齐)
选取文字(自动滤非文字类实体,且不用考虑次序,开窗口选也可)


2
.多文字的间距调整,提示如下:

 文字间距调整方式如下:

1. 水平 2. 垂直 3. 斜向 <1>

若选“1”或缺省值,则
* 输入各文字水平距值(或用鼠标点取)
* 选择对齐方式:(C中心/L左侧/R右侧/H中心) <L>

1 若选“L”或缺省,则:
* 输入这组文字起点。
* 按选后次序选取文字。

2 其它类推。



“2”,则:
* 输入文字垂直间距值(或用鼠标点取)
其它同



“3”,则:
* 按先后次序选取文字。
* 点取斜线起点(即文字排列方向线)
* 点取斜线终点。

(结果所选文字在斜线起点和终点间等分排列)

四、源程序如下:

1.多文字的对齐:

  1. ;--------------------

  2. ;1996.03.04

  3. ;

  4. (defunc:zddq ( / i n txsize ent ent1 o1 o2 o3 o4 a aa oldsiaze newsize

  5. index bb ccp0 p1 p pp ent0 b ss a1 a2 a3 a4 a5 a6)

  6. (setq i 1)

  7. (princ"\n")(princ "选择对齐方式如下:")(princ)

  8. (setq a(getstring "\n L左/R右/C中心/M中点 < L >: "))

  9. (if (= a"")(setq a "L"))

  10. (setq a(strcase a))

  11. (cond ((= a"L")(setq a1 0 a2 11 a4 10 a5 10))

  12. ((= a"M")(setq a1 1 a2 10 a4 11 a5 11))

  13. ((= a"R")(setq a1 2 a2 10 a4 11 a5 11))

  14. ((= a"C")(setq a1 4 a2 10 a4 11 a5 11))

  15. )

  16. (setq b(getint "\n1.横向对齐(使Y座标一样) 2. 纵向对齐(使X座标一样)<2>: "))

  17. (setqtxsize (getpoint "\n点取对齐点<点取参照实体>:"))

  18. (princ"\n")(princ "选取文字(自动滤去非文字实体):")(princ)

  19. (while(< i 10000)

  20. (setq ss(ssget))

  21. (setq n(sslength ss))

  22. (setq index0)

  23. (repeat n

  24. (setq ent0(entget (ssname ss index)))

  25. (if (= (cdr(assoc 72 ent0)) 0)

  26. (progn

  27. (setq a410)

  28. (if (/ = a10)(setq a5 11)(setq a5 10))

  29. )

  30. )

  31. (setq index(+ 1 index))

  32. (setq type(assoc 0 ent0))

  33. (if (="TEXT" (cdr type))

  34. (progn

  35. (setq p0(assoc 72 ent0))

  36. (setq p(cons (car p0) a1))

  37. (setq pp(subst p p0 ent0))

  38. (setq old(assoc 11 pp))

  39. (if (= a"L")

  40. (setq a3(list 0 0))

  41. (setq a3(cdr (assoc 11 pp)))

  42. )

  43. (setq new(cons (car old) a3))

  44. (setq ent(subst new old pp))

  45. (setq o1(cadr (cdr (assoc a4 ent0))))

  46. (setq o2(car (cdr (assoc a4 ent0))))

  47. (if (=txsize nil)

  48. (p rogn

  49. (setq a6(entget (ssname ss 0)))

  50. (setq a6(cdr (assoc a4 a6)))

  51. (setq o3(car a6) o4 (cadr a6))

  52. )

  53. (setq o3(car txsize) o4 (cadr txsize))

  54. )

  55. (setqoldsize (assoc a5 ent0))

  56. (if (and(/= b nil)(/= b 2))

  57. (setq aa o2bb o4 cc (car oldize))

  58. (setq aa o3bb o1 cc (cdr oldsize))

  59. )

  60. (setqnewsize (cons (car oldsize) (list aa bb)))

  61. (setq ent1(subst newsize oldsize ent))

  62. (entmodent1)

  63. )

  64. )

  65. )

  66. )

  67. (prin1)

  68. )

  69. ;--------------------
复制代码


2.多文字的间距调整

  1. edit date:1995.6.1

  2. (defun c:zdjt ( / new old ent ent1 index s ss s1 s2 cj sj n x xs y ys wb wg wc wg0 wg1 zbtype fs i j bbb bj1 bj2 aj1 aj2 cj1 cj2 $a $c $b ss1 ss2 dj1 dj2 zx ej1 ej2 fj1fj2 zk jd)

  3. (setvar"cmdecho" 0)

  4. ; (princ"\n1. order: from top to button. from left to right")

  5. ; (princ"\n2. there is over a entity")(princ)

  6. (princ"\n间距调整方式选择如下:")(princ)

  7. (setq sjnil cj nil)

  8. (setq s1(getint "\n 1.水平 2.垂直 3.斜向 <1>: "))

  9. (if (/ = s13)

  10. (progn

  11. (if (= s1nil)(setq s1 1))

  12. (if (= s11) (setq sj (getdist "\n输入文字水平间距值(或用鼠标点取):"))

  13. (setq cj(getdist "\n输入文字垂直间距值(或用鼠标点取):")))

  14. (setq fs(strcase (getstring "\n选择对齐方式(C中心/L左侧/R右侧/M中点) < L>: ")))

  15. (if (= fs"M")(progn

  16. (command"osnap" "nea")

  17. (setq ss1(getpoint "\n文字起点: "))

  18. (setq ss2(getcorner ss1 "\n文字终点: "))

  19. (setq s2(polar ss1 (angle ss1 ss2) (/ (distance ss1 ss2) 2)))

  20. (command"osnap" "none")

  21. )

  22. (setq s2(getpoint "\n这组文字起点text location point:"))

  23. )

  24. (setq x(car s2) y (cadr s2))

  25. (princ"\n按先后次序选取文字")(princ)

  26. (setq ss(ssget))

  27. (setq n(sslength ss) index 0 i 0 j 0)

  28. (rep eat n

  29. (setq ent(entget (ssname ss index)))

  30. (if (="TEXT" (cdr (assoc 0 ent)))

  31. (pr ogn

  32. (setq i (+ i1))

  33. ( if (= s11)

  34. (setq zb(car (CDR (assoc 10 (entget (ssname ss index))))))

  35. (setq zb(CADR (cdr (assoc 10 (entget (ssname ss index))))))

  36. )

  37. (set q wb(cdr (assoc 1 (entget (ssname ss index))))

  38. wg (cdr(assoc 40 (entget (ssname ss index))))

  39. zk (cdr(assoc 41 (entget (ssname ss index))))

  40. jd (cdr(assoc 50 (entget (ssname ss index))))

  41. zx (cdr(assoc 7 (entget (ssname ss index))))

  42. )

  43. (set (read(strcat "b" (itoa i))) zb);coordinate

  44. (set (read(strcat "a" (itoa i))) wb);word

  45. (set (read(strcat "c" (itoa i))) wg);hight

  46. (set (read(strcat "d" (itoa i))) zx);word style

  47. (set (read(strcat "e" (itoa i))) zk);word wide

  48. (set (read(strcat "f" (itoa i))) jd);word engle

  49. (setq new(cons (car (assoc 1 ent)) " "))

  50. (setq ent1(subst new (assoc 1 ent) ent))

  51. (entmodent1)

  52. )

  53. )

  54. (setq index(+ index 1))

  55. )

  56. (setq n i)

  57. (while(>= n 2)

  58. (setq j 1)

  59. (wh ile(<= j (- n 1))

  60. (setq bj1(eval (read (strcat "b" (itoa j)))))

  61. (setq bj2(eval (read (strcat "b" (itoa (+ j 1))))))

  62. (setq aj1(eval (read (strcat "a" (itoa j)))))

  63. (setq aj2(eval (read (strcat "a" (itoa (+ j 1))))))

  64. (setq cj1(eval (read (strcat "c" (itoa j)))))

  65. (setq cj2(eval (read (strcat "c" (itoa (+ j 1))))))

  66. (setq dj1(eval (read (strcat "d" (itoa j)))))

  67. (setq dj2(eval (read (strcat "d" (itoa (+ j 1))))))

  68. (setq ej1(eval (read (strcat "e" (itoa j)))))

  69. (setq ej2(eval (read (strcat "e" (itoa (+ j 1))))))

  70. (setq fj1(eval (read (strcat "f" (itoa j)))))

  71. (setq fj2(eval (read (strcat "f" (itoa (+ j 1))))))

  72. ; (if (/= s11)(setq bbb bj1 bj1 bj2 bj2 bbb));-----------------

  73. (if (AND (=S1 1)(> bj1 bj2))(BBBB))

  74. (if (AND (=S1 2)(< bj1 bj2))(BBBB))

  75. (setq j (+ j1))

  76. )

  77. (setq n (-n 1))

  78. )

  79. (setq n 0)

  80. (re peat i

  81. (setq n (+ n1))

  82. (setq wg(eval (read (strcat "c" (itoa n)))))

  83. (setq wb(eval (read (strcat "a" (itoa n)))))

  84. (setq zx(eval (read (strcat "d" (itoa n)))))

  85. (setq zk(eval (read (strcat "e" (itoa n)))))

  86. (setq jd(eval (read (strcat "f" (itoa n)))))

  87. (setq zk2(cdr (assoc 41 (tblsearch "style" zx)))

  88. zt (cdr (assoc3 (tblsearch "style" zx)))

  89. zt2 (cdr(assoc 4 (tblsearch "style" zx)))

  90. )

  91. (if (/= zkzk2)

  92. (if (=(strcase zx) "STANDARD")

  93. (command"style" zx "" "0" zk "0" "n""n" "n")

  94. (command"style" zx "" "0" zk "0" "n""n")

  95. )

  96. )

  97. (if (= s1 1)(progn

  98. (setq xs (+x (* sj (- n 1))))

  99. (setq zb(list xs y))

  100. ( if (= fs"")

  101. ( if (>(cdr (assoc 40 (tblsearch "style" zx))) 0.00001)

  102. (command"text" zb (/ (* jd 180.0) pi) wb)

  103. (command"text" zb wg (/ (* jd 180.0) pi) wb)

  104. )

  105. (if (>(cdr (assoc 40 (tblsearch "style" zx))) 0.00001)

  106. (command"text" fs zb (/ (* jd 180.0) pi) wb)

  107. [KG*2](command "text" fs zb wg (/ (* jd 180.0) pi) wb)

  108. )

  109. )

  110. )

  111. (p rogn

  112. (setq ys (-y (* cj (- n 1))))

  113. (setq zb(list x ys))

  114. ( if (= fs"")

  115. ( if (>(cdr (assoc 40 (tblsearch "style" zx))) 0.00001)

  116. (command"text" zb (/ (* jd 180.0) pi) wb)

  117. (command"text" zb wg (/ (* jd 180.0) pi) wb)

  118. )

  119. (if (>(cdr (assoc 40 (tblsearch "style" zx))) 0.00001)

  120. (command"text" fs zb (/ (* jd 180.0) pi) wb)

  121. (command"text" fs zb wg (/ (* jd 180.0) pi) wb)

  122. )

  123. )

  124. )

  125. )

  126. )

  127. )

  128. (progn

  129. (princ"\n按先后次序选取文字")(princ)

  130. (setq ss(ssget) cd (sslength ss))

  131. (princ"\n按选取文字先后次序,从斜线起点至终点等分这组文字")(princ)

  132. (setq qd(getpoint "\n斜线起点: "))

  133. (setq zd(getpoint qd "\n斜线终点: "))

  134. (setq jd(angle qd zd))

  135. (setq jl(distance qd zd) jl (/ jl (- cd 1)))

  136. (setq i 0)

  137. (repeat cd

  138. (setq zd(polar qd jd (* i jl)))

  139. (setq wg(cdr (assoc 40 (entget (ssname ss i)))))

  140. (setq wb(cdr (assoc 1 (entget (ssname ss i)))))

  141. (command"text" zd wg "0" wb)

  142. (setq i (1+i))

  143. )

  144. )

  145. )

  146. )

  147. (DEFUN BBBB()

  148. (setq b$ bj1a$ aj1 c$ cj1)

  149. (set (read(strcat "b" (itoa j))) bj2)

  150. (set (read(strcat "a" (itoa j))) aj2)

  151. (set (read(strcat "c" (itoa j))) cj2)

  152. (set (read(strcat "b" (itoa (+ j 1)))) b$)

  153. (set (read(strcat "a" (itoa (+ j 1)))) a$)

  154. (set (read(strcat "c" (itoa (+ j 1)))) c$)
  155. )
复制代码
回复
分享到:

使用道具 举报

您需要登录后才可以回帖 登录 | 我要加入

本版积分规则

QQ|小黑屋|Archiver|手机版|联系我们|声振论坛

GMT+8, 2024-5-16 03:59 , Processed in 0.115615 second(s), 17 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表