刚刚随手编的一个相同文字连线的小程序

开心无惧

非常感谢分享

儒门小客

非常感谢分享,局部修改可以实现天正文字连线

xyp1964

1. (defun c:tt ()
   
2.   "相同文字连线"
   
3.   (defun Ep5 (e / p1 p9 p)
   
4.     (vla-getboundingbox (vlax-Ename->Vla-Object e) 'p1 'p9)
   
5.     (setq p(mapcar 'vlax-safearray->list (list p1 p9)))
   
6.     (mapcar '(lambda (x y) (/ (+ x y) 2.0))(car p)(cadr p))
   
7.   )
   
8.   (defun ss2list (ss)
   
9.     (vl-remove-if'(lambda (x) (/= (type x) 'ENAME))(mapcar 'cadr (ssnamex ss)))
   
10.   )
    
11.   (if (and (setq ss1 (ssget ":e:s" '((0 . "TEXT"))))
    
12.            (setq s1 (ssname ss1 0))
    
13.            (setq tx (cdr (assoc 1 (entget s1))))
    
14.            (setq ss (ssget (list '(0 . "TEXT") (cons 1 tx))))
    
15.       )
    
16.     (progn
    
17.       (command "-layer" "m" "文字连线" "c" "6" "" "")
    
18.       (setq p0  (Ep5 s1)
    
19.             lst (vl-remove s1 (ss2list ss))
    
20.       )
    
21.       (foreach x lst (command "line" "non" p0 "non" (Ep5 x) ""))
    
22.       (princ "\n相同文本数量 = ")
    
23.       (princ (length lst))
    
24.       (alert (strcat "\n相同文本数量 = "(itoa (length lst))))
    
25.     )
    
26.   )
    
27.   (princ)
    
28. )

(defun c:tt ()<br />   "相同文字连线"<br />   (defun Ep5 (e / p1 p9 p)<br />     (vla-getboundingbox (vlax-Ename->Vla-Object e) 'p1 'p9)<br />     (setq p(mapcar 'vlax-safearray->list (list p1 p9)))<br />     (mapcar '(lambda (x y) (/ (+ x y) 2.0))(car p)(cadr p))<br />   )<br />   (defun ss2list (ss)<br />     (vl-remove-if'(lambda (x) (/= (type x) 'ENAME))(mapcar 'cadr (ssnamex ss)))<br />   )<br />   (if (and (setq ss1 (ssget ":e:s" '((0 . "TEXT"))))<br />            (setq s1 (ssname ss1 0))<br />            (setq tx (cdr (assoc 1 (entget s1))))<br />            (setq ss (ssget (list '(0 . "TEXT") (cons 1 tx))))<br />       )<br />     (progn<br />       (command "-layer" "m" "文字连线" "c" "6" "" "")<br />       (setq p0  (Ep5 s1)<br />             lst (vl-remove s1 (ss2list ss))<br />       )<br />       (foreach x lst (command "line" "non" p0 "non" (Ep5 x) ""))<br />       (princ "\n相同文本数量 = ")<br />       (princ (length lst))<br />       (alert (strcat "\n相同文本数量 = "(itoa (length lst))))<br />     )<br />   )<br />   (princ)<br /> )