yl_1226 发表于 2005-5-2 14:45:00

给文字外面加框

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

mccad 发表于 2005-5-2 17:32:00

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

ZZXXQQ 发表于 2005-5-3 23:15:00

本帖最后由 作者 于 2009-9-27 20:54:09 编辑

参考程序：
(DEFUN C:TXTBLK () ;文字加框
(SETVAR "CMDECHO" 0)
(SETQ OLDOS (GETVAR "OSMODE"))
(SETVAR "OSMODE" 0)
(PRINC "\nSelect Text : ")
(IF (SETQ SS (SSGET '((0 . "TEXT")))) (PROGN
(COMMAND ".UNDO" "BE")
(SETQ SL (SSLENGTH SS) I 0)
(REPEAT SL
   (SETQ ENT (ENTGET (SSNAME SS I)) I (1+ I))
   (SETQ TEMP    (CADR (TEXTBOX (LIST (ASSOC 1 ENT))))
         PT_BASE (CDR (ASSOC 10 ENT))
         ANG   (CDR (ASSOC 50 ENT)) ;文字转角
         TEXTW   (CDR (ASSOC 41 ENT)) ;文字高宽比
         TEMP_W(* (CAR TEMP) TEXTW) ;实际字宽
         TEMP_H(CADR TEMP))
   (COMMAND "PLINE" PT_BASE
            (SETQ PT (POLAR PT_BASE (+ (/ PI 2) ANG) TEMP_H))
            (POLAR PT ANG TEMP_W)
            (POLAR PT_BASE ANG TEMP_W)
            "C")
)
(COMMAND ".UNDO" "E")
))
(SETVAR "OSMODE" OLDOS)
(SETVAR "CMDECHO" 1)
(PRINC)
)

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

spring 发表于 2005-5-4 08:49:00

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



用 TEXTBOX 函数

贱人 发表于 2005-5-5 21:55:00

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


比如：


请输入缩放倍数&lt;1.2&gt;:

ZZXXQQ 发表于 2005-5-5 22:17:00

本帖最后由 作者 于 2009-9-27 20:54:59 编辑

加上缩放倍数
;文字加外框
(DEFUN C:TXTBLK ()
(SETVAR "CMDECHO" 0)
(SETQ OLDOS (GETVAR "OSMODE"))
(SETVAR "OSMODE" 0)
(PRINC "\nSelect Text : ")
(IF (SETQ SS (SSGET '((0 . "TEXT")))) (PROGN
(COMMAND ".UNDO" "BE")
(SETQ SC (GETDIST "\n输入缩放比例<1>")
      SC (IF SC SC 1))
(SETQ SL (SSLENGTH SS) I 0)
(REPEAT SL
   (SETQ ENT (ENTGET (SSNAME SS I)) I (1+ I))
   (SETQ TEMP    (CADR (TEXTBOX (LIST (ASSOC 1 ENT))))
         PT_BASE (CDR (ASSOC 10 ENT))
         ANG   (CDR (ASSOC 50 ENT)) ;文字转角
         TEXTW   (CDR (ASSOC 41 ENT)) ;文字高宽比
         TEMP_W(* (CAR TEMP) TEXTW) ;实际字宽
         TEMP_H(CADR TEMP)
         TH (* TEMP_H SC)             ;字高放大
         SSC (* (- TH TEMP_H) 0.5)
         TEMP_W (+ TEMP_W SSC SSC)    ;字宽加大同样边距
         PT_BASE (POLAR (POLAR PT_BASE (+ ANG PI) SSC) (+ (/ PI -2) ANG) SSC))
   (COMMAND "PLINE" PT_BASE
            (SETQ PT (POLAR PT_BASE (+ (/ PI 2) ANG) TH))
            (POLAR PT ANG TEMP_W)
            (POLAR PT_BASE ANG TEMP_W)
            "C")
)
(COMMAND ".UNDO" "E")
))
(SETVAR "OSMODE" OLDOS)
(SETVAR "CMDECHO" 1)
(PRINC)
)

贱人 发表于 2005-5-6 11:08:00

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

xyp1964 发表于 2005-5-13 00:17:00

也发一个：

贱人 发表于 2005-6-3 00:19:00

有个严重的问题


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

xyp1964 发表于 2005-6-4 22:21:00

(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)
   (setqss (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)
页: [1] 2
查看完整版本: 给文字外面加框