文字加圈，出错了！循环不了。。。求助！

freeok

434939575 发表于 2015-11-29 19:39

先修改为中间对齐，然后画完圈再改回来？

434939575

这样子，不知道你的意思

琴剑江山_10184

1. (defun C:JQ (/ A B DD EN ENT LEN OS P1 P2 PL PP SS)
   
2.   (setvar "cmdecho" 0)
   
3.   (setq os (getvar 'osmode))
   
4.   (setvar 'osmode 0)
   
5.   (setq dd (getdist "\n 输入字间与圆周距离<2>: "))
   
6.   (if (null dd)
   
7.     (setq dd 2.0)
   
8.   )
   
9.   (setq  ss  (ssget '((0 . "TEXT")))
   
10.   Len (sslength ss)
    
11.   )  
    
12.   (repeat Len
    
13.     (setq en (ssname ss (setq Len (1- Len))))        
    
14.     (vl-cmdf "ucs" "OB" en)
    
15.     (setq ent (entget en)
    
16.           pp  (textbox ent)
    
17.           p1  (car pp)
    
18.           p2  (cadr pp)
    
19.           pL  (mapcar '(lambda (a b) (/ (+ a b) 2)) p1 p2)
    
20.           dr  (+ (/ (distance p1 p2) 2) dd)
    
21.     )
    
22.     (command "circle" pL dr)
    
23.   )
    
24.   (vl-cmdf "ucs" "W")
    
25.   (setvar 'osmode os)
    
26.   (prin1)
    
27. )
    
28. 
    
29. 
    
30. 
    
31. 
    
32. 
    
33. 
    

(defun C:JQ (/ A B DD EN ENT LEN OS P1 P2 PL PP SS)<br />   (setvar "cmdecho" 0)<br />   (setq os (getvar 'osmode))<br />   (setvar 'osmode 0)<br />   (setq dd (getdist "\n 输入字间与圆周距离<2>: "))<br />   (if (null dd)<br />     (setq dd 2.0)<br />   )<br />   (setq  ss  (ssget '((0 . "TEXT")))<br />   Len (sslength ss)<br />   )  <br />   (repeat Len<br />     (setq en (ssname ss (setq Len (1- Len))))        <br />     (vl-cmdf "ucs" "OB" en)<br />     (setq ent (entget en)<br />           pp  (textbox ent)<br />           p1  (car pp)<br />           p2  (cadr pp)<br />           pL  (mapcar '(lambda (a b) (/ (+ a b) 2)) p1 p2)<br />           dr  (+ (/ (distance p1 p2) 2) dd)<br />     )<br />     (command "circle" pL dr)<br />   )<br />   (vl-cmdf "ucs" "W")<br />   (setvar 'osmode os)<br />   (prin1)<br /> )<br /> <br /> <br /> <br /> <br /> <br /> <br />

zdqwy19

freeok 发表于 2015-11-29 19:11
这个也有问题了，第一圈的点不对，不删除此圈，第二个就是对的了

看看这样改

2. (defun C:tt (/ om dd ss i ssn ssdata box p1 p2 p3)
   
3.   (setvar "cmdecho" 0)
   
4.   (setq om (getvar "osmode"))
   
5.   (setvar "osmode" 0)
   
6.   (setq dd (getdist "\n 输入字间与圆周距离<2>:  ")) ;
   
7.   (if (null dd)
   
8.     (setq dd 2.0)
   
9.     dd
   
10.   )
    
11.   (setq ss (ssget))
    
12.   (setq i 0)
    
13.   (repeat (sslength ss)
    
14.     (setq ssn (ssname ss i))
    
15.     (setq ssdata (entget ssn))
    
16.     (if        (= (cdr (assoc 0 ssdata)) "TEXT")
    
17.       (progn (command "ucs" "ob" ssn)
    
18.              (setq box (textbox ssdata)) ;取得文字外框坐标
    
19.              (setq p1 (car box))
    
20.              (setq p3 (cadr box))
    
21.              (setq p2 (list (car p3) (cadr p1) 0.0))
    
22.         (command "circle" "3p" p1 p2 p3)
    
23.         (command "offset" "e" "y" dd (entlast) '(9999999999999999. 9999999999999999. 0.) "")
    
24.             (command "ucs" "p")
    
25.       )
    
26.     )
    
27.     (setq i (1+ i))
    
28.   )
    
29.   (setvar "osmode" om)
    
30.   (prin1)
    
31. )

(defun C:tt (/ om dd ss i ssn ssdata box p1 p2 p3)<br />   (setvar "cmdecho" 0)<br />   (setq om (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (setq dd (getdist "\n 输入字间与圆周距离<2>:  ")) ;<br />   (if (null dd)<br />     (setq dd 2.0)<br />     dd<br />   )<br />   (setq ss (ssget))<br />   (setq i 0)<br />   (repeat (sslength ss)<br />     (setq ssn (ssname ss i))<br />     (setq ssdata (entget ssn))<br />     (if        (= (cdr (assoc 0 ssdata)) "TEXT")<br />       (progn (command "ucs" "ob" ssn)<br />              (setq box (textbox ssdata)) ;取得文字外框坐标<br />              (setq p1 (car box))<br />              (setq p3 (cadr box))<br />              (setq p2 (list (car p3) (cadr p1) 0.0))<br />         (command "circle" "3p" p1 p2 p3)<br />         (command "offset" "e" "y" dd (entlast) '(9999999999999999. 9999999999999999. 0.) "")<br />             (command "ucs" "p")<br />       )<br />     )<br />     (setq i (1+ i))<br />   )<br />   (setvar "osmode" om)<br />   (prin1)<br /> )

llsheng_73

1. (defun c:JQ(/ i ss dd en p1)
   
2. (setq dd(if(setq dd(getdist "\n 输入字间与圆周距离<2>: "))dd 2))
   
3. (if(setq i -1 ss(ssget'((0 . "text"))))
   
4.    (repeat (sslength ss)
   
5.      (entmakex(cons'(0 . "circle")
   
6.    (mapcar'cons'(10 40)(setq i(1+ i)en(entget(ssname ss i))p1(textbox en)
   
7.          p1(list(mapcar'+(cdr(assoc 10 en))(mapcar'*'(0.5 0.5)(apply'mapcar(cons'+ p1))))
   
8.          (+(*(apply'distance p1)0.5)dd)))))))))

(defun c:JQ(/ i ss dd en p1)<br /> (setq dd(if(setq dd(getdist "\n 输入字间与圆周距离<2>: "))dd 2))<br /> (if(setq i -1 ss(ssget'((0 . "text"))))<br />    (repeat (sslength ss)<br />      (entmakex(cons'(0 . "circle")<br />    (mapcar'cons'(10 40)(setq i(1+ i)en(entget(ssname ss i))p1(textbox en)<br />          p1(list(mapcar'+(cdr(assoc 10 en))(mapcar'*'(0.5 0.5)(apply'mapcar(cons'+ p1))))<br />          (+(*(apply'distance p1)0.5)dd)))))))))

freeok

zdqwy19 发表于 2015-11-29 20:26
看看这样改

谢谢兄台，可以用，但是LLSHENG大神的更简洁，可以学习下

freeok

llsheng_73 发表于 2015-11-29 21:32

谢谢大神出手，非常感谢！

lcxing

改好的 发上来呗 大侠

haotaer

高，这个真的还有
高，这个真的还有

dabingrain

1. )

复制代码