普通引线文字改为CAD式关联引线文字

tanle2020

cad的引线文字标注非常好用，引线能够随文字移动和随文字长短改变引线线长，现在想把以前老图里面的普通引线文字标注改为关联式的引线文字标注怎么实现，请求帮助！

ZZXXQQ

做了一个，不理想。算是抛砖引玉吧。

2. (defun c:tt ()
   
3. (setvar "CMDECHO" 0)
   
4. (if (setq ss (ssget '((0 . "*TEXT")))) (progn
   
5. (setq i -1)
   
6. (repeat (sslength ss)
   
7. (setq en (ssname ss (setq i (1+ i)))
   
8. ent (entget en)
   
9. txtbox (textbox ent)
   
10. pt (cdr(assoc 10 ent))
    
11. txt (cdr(assoc 1 ent))
    
12. p1 (mapcar '+ pt (car txtbox))
    
13. p2 (mapcar '+ p1 (cadr txtbox))
    
14. p3 (mapcar '+ (list (car p2) (cadr p1)) '(5 -5))
    
15. p4 (mapcar '+ (list (car p1) (cadr p2)) '(-5 5)))
    
16. (if (setq ss1 (ssget "C" p2 p4 '((0 . "LEADER")))) (progn
    
17. (setq en1 (ssname ss1 0) ent1 (entget en1))
    
18. (setq plst (list))
    
19. (foreach x ent1 (if (= (car x) 10) (setq plst (cons (cdr x) plst))))
    
20. (setq plst (reverse plst))
    
21. (command "_.LEADER" (car plst) (cadr plst) "" txt "")
    
22. (entdel en)
    
23. (entdel en1)
    
24. ))
    
25. )
    
26. ))
    
27. (setvar "CMDECHO" 1)
    
28. (princ)
    
29. )
    

(defun c:tt ()<br /> (setvar "CMDECHO" 0)<br /> (if (setq ss (ssget '((0 . "*TEXT")))) (progn<br /> (setq i -1)<br /> (repeat (sslength ss)<br /> (setq en (ssname ss (setq i (1+ i)))<br /> ent (entget en)<br /> txtbox (textbox ent)<br /> pt (cdr(assoc 10 ent))<br /> txt (cdr(assoc 1 ent))<br /> p1 (mapcar '+ pt (car txtbox))<br /> p2 (mapcar '+ p1 (cadr txtbox))<br /> p3 (mapcar '+ (list (car p2) (cadr p1)) '(5 -5))<br /> p4 (mapcar '+ (list (car p1) (cadr p2)) '(-5 5)))<br /> (if (setq ss1 (ssget "C" p2 p4 '((0 . "LEADER")))) (progn<br /> (setq en1 (ssname ss1 0) ent1 (entget en1))<br /> (setq plst (list))<br /> (foreach x ent1 (if (= (car x) 10) (setq plst (cons (cdr x) plst))))<br /> (setq plst (reverse plst))<br /> (command "_.LEADER" (car plst) (cadr plst) "" txt "")<br /> (entdel en)<br /> (entdel en1)<br /> ))<br /> )<br /> ))<br /> (setvar "CMDECHO" 1)<br /> (princ)<br /> )<br />

tanle2020

ZZXXQQ 发表于 2013-5-31 23:12
做了一个，不理想。算是抛砖引玉吧。

非常感谢ZZXXQQ版主出手，功能已经差不多达到了，只是下图反方向的无反应。希望版主能够完善一下。

ZZXXQQ

沙发改了，再试试。

tanle2020

ZZXXQQ 发表于 2013-6-4 08:44
沙发改了，再试试。

左右方向都无反应了，还有(textbox ent)貌似对多行文字出错。

Michael_GM

再试试

vladimir

很不错的程序，谢谢楼主分享啊。