王与韩1 发表于 2014-7-30 18:54:49

求一简单程序

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

ZZXXQQ 发表于 2014-7-30 20:21:10

;显示下一字 明经 ZZXXQQ 2014.7.30
(defun c:tt ()
(vl-load-com)
(if (and(setq s1 (entsel "\n选择文字: "))
         (setq ent (entget(car s1)))
         (= (cdr(assoc 0 ent)) "TEXT")) (progn
(setq txt (cdr(assoc 1 ent)))
(if (>(sslength(setq ss (ssget "X" (list '(0 . "TEXT") (cons 1 txt))))) 1) (progn
   (ssdel (car s1) ss)
   (while (>(sslength ss) 0)
    (setq en (ssname ss 0))
    (ssdel en ss)
    (vla-getboundingbox (vlax-ename->vla-object en) 'p1 'p2)
    (setq p1 (vlax-safearray->list p1) p2 (vlax-safearray->list p2))
    (command "_.ZOOM" "W" p1 p2)
    (setq k (getpoint))
   )
))
))
(princ)
)

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

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

王与韩1 发表于 2014-7-31 11:19:20

xyp1964 发表于 2014-7-30 22:32 static/image/common/back.gif


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

langjs 发表于 2014-7-31 11:21:34

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

王与韩1 发表于 2014-7-31 11:51:54

xyp1964 发表于 2014-7-30 22:32 static/image/common/back.gif


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

王与韩1 发表于 2014-7-31 12:00:38

ZZXXQQ 发表于 2014-7-30 20:21 static/image/common/back.gif


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

kwok 发表于 2014-7-31 12:46:22

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

王与韩1 发表于 2014-7-31 12:51:39

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

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

edata 发表于 2014-7-31 16:09:18

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