[讨论][求助]哪位高手帮忙升级一下这个定位文本的程序.

userzhl

原程序:

(defun C:zhl_TP (/ p l n e os as ns st s nsl osl sl si chf chm chm2 olderr)
;   (princ "\n本程序快捷键为 tp !\n")
   (setq olderr  *error*             ; Initialize variables
  *error* tperr
  chm     0
  chm2   0)
   (setq p (ssget '((0 . "*TEXT"))))                 ; Select objects
   (if p (progn                      ; If any objects selected
      (while (= 0 (setq osl (strlen (setq os (getstring t "\n请输入要查找的文字：")))))
     (princ "输入错误，请重新输入！")
      );while
      (setq nsl (strlen (setq ns os)))
      (setq l 0 n (sslength p))
      (while (< l n)                 ; For each selected object...
  (if (= "TEXT" (cdr (assoc 0 (setq e (entget (ssname p l))))))
     (progn
        (setq chf nil si 1)
        (setq s (cdr (setq as (assoc 1 e))))
        (while (= osl (setq sl (strlen (setq st (substr s si osl)))))
    (if (= st os)
        (progn
   (setq s (strcat (substr s 1 (1- si)) ns
     (substr s (+ si osl))))
   (setq chf t) ; Found old string
   (setq si (+ si nsl))
        )
        (setq si (1+ si))
    )
        );while
        (if chf (progn        ; Fixed at the text and zoom to it
    (setq pc (list (nth 1 (assoc 10 e)) (nth 2 (assoc 10 e)) 0) )
    (setq th (* 30 (cdr (assoc 40 e)) ) )
    (command "zoom" "c" pc th)
    (initget "Next Xit")
    (setq key (getkword "\n选择显示下一个或退出，N下一个/X退出/ <N下一个>："))
    (if (not key) (setq key "NEXT"))
    (if (= (strcase key) "XIT") (setq l n chm (1+ chm) ) )
    (if (= (strcase key) "NEXT")
    (setq chm (1+ chm))
    );if
        );progn
        );if

     );progn
  );if
  (setq l (1+ l))
      );while
  (setq l 0 chm2 0)
  (while (< l n)                 ; For each selected object...
  (if (= "TEXT" (cdr (assoc 0 (setq e (entget (ssname p l))))))
     (progn
        (setq chf nil si 1)
        (setq s (cdr (setq as (assoc 1 e))))
        (while (= osl (setq sl (strlen (setq st (substr s si osl)))))
    (if (= st os)
        (progn
   (setq s (strcat (substr s 1 (1- si)) ns
     (substr s (+ si osl))))
   (setq chf t) ; Found old string
   (setq si (+ si nsl))
        )
        (setq si (1+ si))
    )
        );while
        (if chf
    (setq chm2 (1+ chm2))
        );if

     );progn
  );if
  (setq l (1+ l))
      );while
     
   ));ifprogn
   (princ "\n共有 ")
   (princ chm2)
   (princ " 个定位点，目前定位在第 ")                ; Print total points fixed
   (princ chm)
   (princ " 个定位点，定位完成!")  
;   (terpri)
   (setq *error* olderr)             ; Restore old *error* handler
   (princ)
)

想做成这样的对话框:

 

 对话框:

 

 

userzhl

哪位高手能帮忙升级一下?

userzhl

难道大家对这种功能不感兴趣?

gao051525

哇，终于找到了，帮顶。我也很需要文本定位，不然在一个大图里面找一个文本太难了

flytoday

去卜哥买个超好就三十………

功夫佬

螺丝就特别多感兴趣啦，你有呒？我想找都找不着更好的！

gao051525

顶！！！！