浏览相同文字

st788796

1. (defun c:tt (/ e el ss sl ell i str app)
   
2.   (if (and (setq e (car (entsel "\nPick Text: ")))
   
3.            (setq el (entget e))
   
4.            (eq (cdr (assoc 0 el)) "TEXT")
   
5.            (setq ss (ssget "X" (list (assoc 1 el))))
   
6.            (> (setq sl (sslength ss)) 1)
   
7.       )
   
8.     (progn
   
9.       (setq i        sl
   
10.             app        (vla-get-application (vlax-get-acad-object))
    
11.       )
    
12.       (repeat sl
    
13.         (setq ell (cons (ssname ss (setq i (1- i))) ell))
    
14.       )
    
15.       (princ
    
16.         (strcat        (setq str (strcat "\n共 " (itoa sl) " 个文字"))
    
17.                 "...."
    
18.         )
    
19.       )
    
20.       (setq i 0)
    
21.       (mapcar '(lambda (x / bp up)
    
22.                  (vla-getboundingbox x 'bp 'up)
    
23.                  (vla-zoomwindow app bp up)
    
24.                  (vla-zoomscaled app 0.8 acZoomScaledRelative)
    
25.                  (princ        (strcat        str
    
26.                                 " , "
    
27.                                 "第 "
    
28.                                 (itoa (setq i (1+ i)))
    
29.                                 " 个文字...."
    
30.                         )
    
31.                  )
    
32.                  (getpoint "\n点击下一个...")
    
33.                )
    
34.               (mapcar 'vlax-ename->vla-object ell)
    
35.       )
    
36.     )
    
37.   )
    
38.   (princ)
    
39. )
    

(defun c:tt (/ e el ss sl ell i str app)<br />   (if (and (setq e (car (entsel "\nPick Text: ")))<br />            (setq el (entget e))<br />            (eq (cdr (assoc 0 el)) "TEXT")<br />            (setq ss (ssget "X" (list (assoc 1 el))))<br />            (> (setq sl (sslength ss)) 1)<br />       )<br />     (progn<br />       (setq i        sl<br />             app        (vla-get-application (vlax-get-acad-object))<br />       )<br />       (repeat sl<br />         (setq ell (cons (ssname ss (setq i (1- i))) ell))<br />       )<br />       (princ<br />         (strcat        (setq str (strcat "\n共 " (itoa sl) " 个文字"))<br />                 "...."<br />         )<br />       )<br />       (setq i 0)<br />       (mapcar '(lambda (x / bp up)<br />                  (vla-getboundingbox x 'bp 'up)<br />                  (vla-zoomwindow app bp up)<br />                  (vla-zoomscaled app 0.8 acZoomScaledRelative)<br />                  (princ        (strcat        str<br />                                 " , "<br />                                 "第 "<br />                                 (itoa (setq i (1+ i)))<br />                                 " 个文字...."<br />                         )<br />                  )<br />                  (getpoint "\n点击下一个...")<br />                )<br />               (mapcar 'vlax-ename->vla-object ell)<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br />

xvjiex

感谢楼主分享浏览相同文字！