各位大佬看下，相同文字加框的功能

嘒彼小星

1. (defun C:tt ()
   
2.         (command "UNDO" "be")
   
3.         (if (setq E  (cdr (assoc 1 (entget (car (entsel))))))
   
4.                 (progn
   
5.                         (setq ss (ssget (list '(0 . "TEXT")(cons 1 E))))
   
6.                         (setq ss_gs (sslength ss))
   
7.                         (setq i 0)
   
8.                         (repeat ss_gs
   
9.                                 (setq ss_n (ssname ss i))
   
10.                                 (command "UCS" "e" ss_n)
    
11.                                 (setq ss_data (entget ss_n))
    
12.                                 (setq text_box (textbox ss_data))
    
13.                                 (setq text_box_1 (car text_box))
    
14.                                 (setq text_box_3 (cadr text_box))
    
15.                                 (command "RECTANG" text_box_1 text_box_3)
    
16.                                 (setq i (1+ i))
    
17.                         )
    
18.                         (command "UCS" "")
    
19.                         (princ (strcat"\n共有" (itoa ss_gs) "个相同文字加框"))
    
20.                 )
    
21.         )
    
22.         (command "UNDO" "e")
    
23.         (print)
    
24. )

(defun C:tt ()<br />         (command "UNDO" "be")<br />         (if (setq E  (cdr (assoc 1 (entget (car (entsel))))))<br />                 (progn<br />                         (setq ss (ssget (list '(0 . "TEXT")(cons 1 E))))<br />                         (setq ss_gs (sslength ss))<br />                         (setq i 0)<br />                         (repeat ss_gs <br />                                 (setq ss_n (ssname ss i))<br />                                 (command "UCS" "e" ss_n)<br />                                 (setq ss_data (entget ss_n))<br />                                 (setq text_box (textbox ss_data))<br />                                 (setq text_box_1 (car text_box))<br />                                 (setq text_box_3 (cadr text_box))<br />                                 (command "RECTANG" text_box_1 text_box_3)<br />                                 (setq i (1+ i))<br />                         )<br />                         (command "UCS" "")<br />                         (princ (strcat"\n共有" (itoa ss_gs) "个相同文字加框"))<br />                 )<br />         )<br />         (command "UNDO" "e")<br />         (print)<br /> )

664571221

vitalgg 发表于 2023-7-10 13:39
源码：
https://gitee.com/atlisp/packages/blob/main/at-text/box.lsp

兄弟你考虑的很全面啊

664571221

xyp1964 发表于 2023-7-10 14:21

谢谢派大.......

664571221

嘒彼小星 发表于 2023-7-10 16:21

谢谢兄弟.......

jun353835273

664571221 发表于 2023-7-10 08:56
那个圆的我有

http://bbs.mjtd.com/thread-175477-1-1.html
这个查找的改改几句代码就可以加框了

loveu515

嘒彼小星 发表于 2023-7-10 16:21

感谢分享，学习一下

664571221

jun353835273 发表于 2023-7-14 08:08
http://bbs.mjtd.com/thread-175477-1-1.html
这个查找的改改几句代码就可以加框了

大佬能不能改下，我改不来