给文字外面加框

yl_1226

为文字加一个矩形框，文字的高度可以求出，但宽度求不出来，应怎么办，文字长度是不固定的

mccad

文字加框的最简单的方法就是用形位公差来写文字。

ZZXXQQ

参考程序：

2. (DEFUN C:TXTBLK () ;文字加框
3. (SETVAR "CMDECHO" 0)
4. (SETQ OLDOS (GETVAR "OSMODE"))
5. (SETVAR "OSMODE" 0)
6. (PRINC "\nSelect Text : ")
7. (IF (SETQ SS (SSGET '((0 . "TEXT")))) (PROGN
8.   (COMMAND ".UNDO" "BE")
9.   (SETQ SL (SSLENGTH SS) I 0)
10.   (REPEAT SL
11.    (SETQ ENT (ENTGET (SSNAME SS I)) I (1+ I))
12.    (SETQ TEMP    (CADR (TEXTBOX (LIST (ASSOC 1 ENT))))
13.          PT_BASE (CDR (ASSOC 10 ENT))
14.          ANG     (CDR (ASSOC 50 ENT)) ;文字转角
15.          TEXTW   (CDR (ASSOC 41 ENT)) ;文字高宽比
16.          TEMP_W  (* (CAR TEMP) TEXTW) ;实际字宽
17.          TEMP_H  (CADR TEMP))
18.    (COMMAND "PLINE" PT_BASE
19.             (SETQ PT (POLAR PT_BASE (+ (/ PI 2) ANG) TEMP_H))
20.             (POLAR PT ANG TEMP_W)
21.             (POLAR PT_BASE ANG TEMP_W)
22.             "C")
23.   )
24.   (COMMAND ".UNDO" "E")
25. ))
26. (SETVAR "OSMODE" OLDOS)
27. (SETVAR "CMDECHO" 1)
28. (PRINC)
29. )

复制代码

运行上面程序可以给图中已写文字加框。

spring

(defun c:textblk (/ ss n en ed textva tb)
(setq ss (ssget '((0 . "TEXT"))))
(setq n 0)
(while (> (sslength ss) n)
(setq en (ssname ss n))
(setq ed (entget en))
(setq textva (assoc 1 ed))
(setq tb (textbox (list textva)))
(command "_.ucs" "Object" en)
(command "_.RECTANG" (car tb) (cadr tb))
(setq n (1+ n))
)
(princ)
) 用 TEXTBOX 函数

贱人

可以啊，不过做到最后一步时能不能多一个选项，让你选择这个矩形框的缩放倍数（以矩形中心为缩放基点），和字一样大不好看，字也看不清


比如：


请输入缩放倍数<1.2>:

ZZXXQQ

加上缩放倍数

2. ;文字加外框
3. (DEFUN C:TXTBLK ()
4. (SETVAR "CMDECHO" 0)
5. (SETQ OLDOS (GETVAR "OSMODE"))
6. (SETVAR "OSMODE" 0)
7. (PRINC "\nSelect Text : ")
8. (IF (SETQ SS (SSGET '((0 . "TEXT")))) (PROGN
9.   (COMMAND ".UNDO" "BE")
10.   (SETQ SC (GETDIST "\n输入缩放比例<1>")
11.         SC (IF SC SC 1))
12.   (SETQ SL (SSLENGTH SS) I 0)
13.   (REPEAT SL
14.    (SETQ ENT (ENTGET (SSNAME SS I)) I (1+ I))
15.    (SETQ TEMP    (CADR (TEXTBOX (LIST (ASSOC 1 ENT))))
16.          PT_BASE (CDR (ASSOC 10 ENT))
17.          ANG     (CDR (ASSOC 50 ENT)) ;文字转角
18.          TEXTW   (CDR (ASSOC 41 ENT)) ;文字高宽比
19.          TEMP_W  (* (CAR TEMP) TEXTW) ;实际字宽
20.          TEMP_H  (CADR TEMP)
21.          TH (* TEMP_H SC)             ;字高放大
22.          SSC (* (- TH TEMP_H) 0.5)
23.          TEMP_W (+ TEMP_W SSC SSC)    ;字宽加大同样边距
24.          PT_BASE (POLAR (POLAR PT_BASE (+ ANG PI) SSC) (+ (/ PI -2) ANG) SSC))
25.    (COMMAND "PLINE" PT_BASE
26.             (SETQ PT (POLAR PT_BASE (+ (/ PI 2) ANG) TH))
27.             (POLAR PT ANG TEMP_W)
28.             (POLAR PT_BASE ANG TEMP_W)
29.             "C")
30.   )
31.   (COMMAND ".UNDO" "E")
32. ))
33. (SETVAR "OSMODE" OLDOS)
34. (SETVAR "CMDECHO" 1)
35. (PRINC)
36. )

复制代码

贱人

完美的程序，收藏，多谢大狭

xyp1964

也发一个：

贱人

有个严重的问题


如果给中文字(如hztxt.shx)加框了,再给其他字加框就出错了(一直以中文字的框为大小了)

xyp1964

2. (load "xyp_lib");加载通用函数
3. ;|
4. 如果已经下载xyp_lib并放到搜索路径下可以不再下载!
5. 利用以下任何一种方式即可加载和运行通用函数内的所有子程序：
6. 1.在acad.lsp中增加(load"xyp_lib")
7. 2.在每个程序内增加(load"xyp_lib")
8. 3.在command下，输入(load"xyp_lib")
9. 4.在菜单.mnl中增加(load"xyp_lib")
10. 通用函数下载地址:
11. http://bbs.mjtd.com/forum.php?mod=viewthread&tid=37554
12. |;(defun c:wbk ()
13.    (CMDLA0)
14.    (setq  ss (ssget '((0 . "TEXT")))
15.   n   -1
16.    )
17.    (while (setq s1 (ssname ss (setq n (1+ n))))
18.        (setq tb (textbox (list (assoc 1 (entget s1))))       )
19.        (command "_.ucs" "Object" s1)
20.        (command "_.RECTANG" (car tb) (cadr tb))
21.        (setq s1 (entlast))
22.        (command "scale" s1 "" (_midp (car tb) (cadr tb)) "1.1")
23.    )
24.    (command "_.ucs" "")
25.    (CMDLA1)
26. )
27. (princ "wbk   (文本框)")
28. (princ)

(load "xyp_lib");加载通用函数 ;| 如果已经下载xyp_lib并放到搜索路径下可以不再下载! 利用以下任何一种方式即可加载和运行通用函数内的所有子程序： 1.在acad.lsp中增加(load"xyp_lib") 2.在每个程序内增加(load"xyp_lib") 3.在command下，输入(load"xyp_lib") 4.在菜单.mnl中增加(load"xyp_lib") 通用函数下载地址: http://bbs.mjtd.com/forum.php?mod=viewthread&tid=37554 |;(defun c:wbk ()    (CMDLA0)    (setq  ss (ssget '((0 . "TEXT")))   n   -1    )    (while (setq s1 (ssname ss (setq n (1+ n))))        (setq tb (textbox (list (assoc 1 (entget s1))))       )        (command "_.ucs" "Object" s1)        (command "_.RECTANG" (car tb) (cadr tb))        (setq s1 (entlast))        (command "scale" s1 "" (_midp (car tb) (cadr tb)) "1.1")    )    (command "_.ucs" "")    (CMDLA1) ) (princ "wbk   (文本框)") (princ)