批量文字矩形框改为圆，代码问题请教

meja

MZ_li 发表于 2023-6-19 09:54
你这段的加圆不能圈在文字外框

我取的是文字高度，不是宽度，呵呵，用来给序号加圆圈而已，你想文字外框，就是要文字宽度

xyp1964

meja 发表于 2023-6-18 13:16
院长，你这代码十年前就编好了吧，我是来请教改代码的

1. (defun c:tt ()
   
2.   (setq i 0)
   
3.   (if (setq ss (ssget '((0 . "text"))))
   
4.     (repeat (sslength ss)
   
5.       (setq s1        (ssname ss i)
   
6.             i        (1+ i)
   
7.             ptn        (textbox (entget s1))
   
8.             p10        (cdr (assoc 10 (entget s1)))
   
9.             p1        (car ptn)
   
10.             p2        (cadr ptn)
    
11.             p1        (mapcar '(lambda (x y) (+ x y)) p1 p10)
    
12.             p2        (mapcar '(lambda (x y) (+ x y)) p2 p10)
    
13.             pc        (mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2)
    
14.             rr        (* (distance p1 p2) 0.5)
    
15.       )
    
16.       (command "circle" "non" pc rr)
    
17.     )
    
18.   )
    
19.   (princ)
    
20. )
    

(defun c:tt ()<br />   (setq i 0)<br />   (if (setq ss (ssget '((0 . "text"))))<br />     (repeat (sslength ss)<br />       (setq s1        (ssname ss i)<br />             i        (1+ i)<br />             ptn        (textbox (entget s1))<br />             p10        (cdr (assoc 10 (entget s1)))<br />             p1        (car ptn)<br />             p2        (cadr ptn)<br />             p1        (mapcar '(lambda (x y) (+ x y)) p1 p10)<br />             p2        (mapcar '(lambda (x y) (+ x y)) p2 p10)<br />             pc        (mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2)<br />             rr        (* (distance p1 p2) 0.5)<br />       )<br />       (command "circle" "non" pc rr)<br />     )<br />   )<br />   (princ)<br /> )<br />

meja

xyp1964 发表于 2023-6-20 00:02

对你的佩服犹如滔滔江水有本事追加一个对大部分图元（线 弧 字 块）加圆的

xyp1964

meja 发表于 2023-6-20 08:33
对你的佩服犹如滔滔江水有本事追加一个对大部分图元（线 弧 字 块）加圆的

1. (defun c:tt ()
   
2.   (setq i 0)
   
3.   (if (setq ss (ssget))
   
4.     (repeat (sslength ss)
   
5.       (setq s1        (ssname ss i)
   
6.             i        (1+ i)
   
7.             ptn (xyp-9ptLIst s1)
   
8.             pc        (nth 4 ptn)
   
9.               rr        (* (distance (car ptn) (last ptn)) 0.5)
   
10.       )
    
11.       (command "circle" "non" pc rr)
    
12.     )
    
13.   )
    
14.   (princ)
    
15. )

(defun c:tt ()<br />   (setq i 0)<br />   (if (setq ss (ssget))<br />     (repeat (sslength ss)<br />       (setq s1        (ssname ss i)<br />             i        (1+ i)<br />             ptn (xyp-9ptLIst s1)<br />             pc        (nth 4 ptn)<br />               rr        (* (distance (car ptn) (last ptn)) 0.5)<br />       )<br />       (command "circle" "non" pc rr)<br />     )<br />   )<br />   (princ)<br /> )