求一简单程序

王与韩1

在同一图纸内，点击一段文字，即跳转至与其内容相同的另一段文字处，如点击"7APEsp",就跳转至同一图纸的另一个"7APEsp"那里，先谢过各位赏脸看帖的大神了

ZZXXQQ

游客，本帖隐藏的内容需要发帖数高于 5 才可浏览，你当前发帖数只有 0

xyp1964

2. ;; 跳显相同文本
   
3. (defun c:tt ()
   
4.   (if (setq ss (ssget ":E:S" '((0 . "text"))))
   
5.     (progn
   
6.       (if s2 (redraw s2 4))
   
7.       (setq s1 (ssname ss 0))
   
8.       (if (and (setq ss (ssget "X" (list '(0 . "TEXT") (cons 1 (xyp-DXF 1 s1)))))
   
9.                (>= (sslength ss) 2)
   
10.           )
    
11.         (progn
    
12.           (setq s2 (ssname (ssdel s1 ss) 0))
    
13.           (redraw s2 3)
    
14.           ;(command "ZOOM" "W" (xyp-9pt s2 1) (xyp-9pt s2 9))
    
15.         )
    
16.       )
    
17.     )
    
18.   )
    
19.   (princ)
    
20. )

;; 跳显相同文本<br /> (defun c:tt ()<br />   (if (setq ss (ssget ":E:S" '((0 . "text"))))<br />     (progn<br />       (if s2 (redraw s2 4))<br />       (setq s1 (ssname ss 0))<br />       (if (and (setq ss (ssget "X" (list '(0 . "TEXT") (cons 1 (xyp-DXF 1 s1)))))<br />                (>= (sslength ss) 2)<br />           )<br />         (progn<br />           (setq s2 (ssname (ssdel s1 ss) 0))<br />           (redraw s2 3)<br />           ;(command "ZOOM" "W" (xyp-9pt s2 1) (xyp-9pt s2 9))<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

王与韩1

xyp1964 发表于 2014-7-30 22:32

请问大师，能不能不放大，而是移动至其位置，亮显之类的

langjs

我的仿WORD查找和替换有类似功能，源码在论坛里

王与韩1

xyp1964 发表于 2014-7-30 22:32

额，显示的是no function definition: XYP-DXF,麻烦大师看下哈

王与韩1

ZZXXQQ 发表于 2014-7-30 20:21
[/post]

请问大师，能不能不放大，而是移动至其位置，亮显之类的

kwok

如果同时有多个相同，变成随机跳，不如cad直接快速选择.

王与韩1

kwok 发表于 2014-7-31 12:46
如果同时有多个相同，变成随机跳，不如cad直接快速选择.

一般就只有两个唯一对应的

edata

Z版平移亮显

1. (defun c:tt (/ ang cen cen2 en ent k new_p3 new_p4 p1 p2 p3 p4 s1 ss txt view_pts)
   
2. (vl-load-com)
   
3. (if (and(setq s1 (entsel "\n选择文字: "))
   
4.          (setq ent (entget(car s1)))
   
5.          (= (cdr(assoc 0 ent)) "TEXT"))
   
6.    (progn
   
7.      (setq txt (cdr(assoc 1 ent)))
   
8.      (if (>(sslength(setq ss (ssget "X" (list '(0 . "TEXT") (cons 1 txt))))) 1)
   
9.        (progn
   
10.          (setvar 'cmdecho 0)
    
11.          (ssdel (car s1) ss)
    
12.          (while (>(sslength ss) 0)
    
13.            (setq en (ssname ss 0))
    
14.            (vla-getboundingbox (vlax-ename->vla-object en) 'p1 'p2)
    
15.            (setq p1 (vlax-safearray->list p1) p2 (vlax-safearray->list p2))
    
16.            (setq cen(mapcar '(lambda(x y)(*(+ x y) 0.5)) p1 p2))
    
17.            (setq view_pts(zj-get-scr-coods))
    
18.            (setq p3(car view_pts) p4 (cadr view_pts))
    
19.            (setq cen2 (mapcar '(lambda(x y)(*(+ x y) 0.5)) p3 p4))
    
20.            (setq ang(angle p3 p4))
    
21.            (setq new_p3(polar cen ang (distance cen2 p3)))
    
22.            (setq new_p4(polar cen ang (* -1 (distance cen2 p3))))
    
23.            (command "_.ZOOM" "W" new_p3 new_p4)
    
24.            (sssetfirst nil (ssadd en))
    
25.            (if(/= (sslength ss) 1)(setq k (getpoint"\r下一个:     "))(princ"\n完成!"))
    
26.            (ssdel en ss)
    
27.            )
    
28.          (setvar 'cmdecho 1)
    
29.          )
    
30.        )
    
31.      )
    
32.    )
    
33. (princ)
    
34. )
    
35. ;;;返回绘图区左下角与右上角
    
36. (defun zj-get-scr-coods (/ half_h half_w pt_cen lst ptx pty)
    
37.    (setq pt_cen (trans (GETVAR "VIEWCTR") 1 2)
    
38.    ptx (car pt_cen)
    
39.    pty (cadr pt_cen)
    
40.       half_h (* 0.5 (GETVAR "VIEWSIZE"))
    
41.    half_w (* half_h (/ (car (GETVAR "SCREENSIZE")) (cadr (GETVAR "SCREENSIZE"))))
    
42.    )
    
43.   (LIST (LIST (- ptx half_w) (- pty half_h)) (LIST (+ ptx half_w) (+ pty half_h)))
    
44. )
    

(defun c:tt (/ ang cen cen2 en ent k new_p3 new_p4 p1 p2 p3 p4 s1 ss txt view_pts)<br /> (vl-load-com)<br /> (if (and(setq s1 (entsel "\n选择文字: "))<br />          (setq ent (entget(car s1)))<br />          (= (cdr(assoc 0 ent)) "TEXT"))<br />    (progn<br />      (setq txt (cdr(assoc 1 ent)))<br />      (if (>(sslength(setq ss (ssget "X" (list '(0 . "TEXT") (cons 1 txt))))) 1)<br />        (progn<br />          (setvar 'cmdecho 0)<br />          (ssdel (car s1) ss)<br />          (while (>(sslength ss) 0)<br />            (setq en (ssname ss 0))<br />            (vla-getboundingbox (vlax-ename->vla-object en) 'p1 'p2)<br />            (setq p1 (vlax-safearray->list p1) p2 (vlax-safearray->list p2))<br />            (setq cen(mapcar '(lambda(x y)(*(+ x y) 0.5)) p1 p2))<br />            (setq view_pts(zj-get-scr-coods))<br />            (setq p3(car view_pts) p4 (cadr view_pts))<br />            (setq cen2 (mapcar '(lambda(x y)(*(+ x y) 0.5)) p3 p4))<br />            (setq ang(angle p3 p4))<br />            (setq new_p3(polar cen ang (distance cen2 p3)))<br />            (setq new_p4(polar cen ang (* -1 (distance cen2 p3))))<br />            (command "_.ZOOM" "W" new_p3 new_p4)<br />            (sssetfirst nil (ssadd en))<br />            (if(/= (sslength ss) 1)(setq k (getpoint"\r下一个:     "))(princ"\n完成!"))<br />            (ssdel en ss)<br />            )<br />          (setvar 'cmdecho 1)<br />          )<br />        )<br />      )<br />    )<br /> (princ)<br /> )<br /> ;;;返回绘图区左下角与右上角<br /> (defun zj-get-scr-coods (/ half_h half_w pt_cen lst ptx pty)<br />    (setq pt_cen (trans (GETVAR "VIEWCTR") 1 2)<br />    ptx (car pt_cen)<br />    pty (cadr pt_cen)<br />       half_h (* 0.5 (GETVAR "VIEWSIZE"))<br />    half_w (* half_h (/ (car (GETVAR "SCREENSIZE")) (cadr (GETVAR "SCREENSIZE"))))<br />    ) <br />   (LIST (LIST (- ptx half_w) (- pty half_h)) (LIST (+ ptx half_w) (+ pty half_h)))<br /> )<br />