这样选择文字，能不能实现呢

dhy

源码如下，如果让它选择DAT文件里面的文字是，从多字到单子优先选择呢？
如果没有优先选择，比如当图中如果是AAAA的时候，原来替换成3的，可是现在替换成46了，当图中如果是AAAAAA的时候，原来替换成1的，可是现在替换成456了.这不是我想要的结果。当DAT文件里面没有AAAA而图中出现时，则替换出来一个是2个AA，即是5 5，其他的类推请高手帮忙改一下，这个如果实现了，可以减轻我的工作负担。谢谢！！！
(defun c:fy

dhy

为什么我的源码没有发出去的呢，效果如图
(defun c:fy
            (/ ss fd data aa chi eng ent ent_data old new chi_n chi_o)
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (setq ss (ssget (list (cons 0 "*ext"))))
  (setq fd (open (findfile "fanyi.dat") "r"))
  (setq data (repeat 4 (read-line fd)))
  (while (/= data "EXIT")
    (while (= (wcmatch data "*\t*") t)
      (setq data (vl-string-subst " " "\t" data))
    )
    (while (= (wcmatch data "*  *") t)
      (setq data (vl-string-subst " " "  " data))
    )
    (if        (and (/= data "") (/= data " "))
      (progn
                                        ;start if-1
        (setq aa (vl-string-position 32 data))
        (if (= aa 0)
          (progn
            (setq data (substr data (+ 2 aa)))
            (setq aa (vl-string-position 32 data))
            (setq chi (substr data 1 aa))
            (setq eng (substr data (+ 2 aa)))
            (if        (= (ascii (substr eng (strlen eng))) 32)
              (setq eng (substr eng 1 (1- (strlen eng))))
            )
          )
        )
        (if (/= aa 0)
          (progn
            (setq aa (vl-string-position 32 data))
            (setq chi (substr data 1 aa))
            (setq eng (substr data (+ 2 aa)))
            (if        (= (ascii (substr eng (strlen eng))) 32)
              (setq eng (substr eng 1 (1- (strlen eng))))
            )
          )
        )
                                        ;
                                        ;
        (setq n 0)
        (while (< n (sslength ss))
          (setq ent (ssname ss n))
          (setq ent_data (entget ent))
          (setq old (assoc 1 ent_data))
          (setq chi_o (cdr old))
          (setq chi_n (vl-string-subst eng chi chi_o))
          (setq new (cons 1 chi_n))
          (entmod (subst new old ent_data))
          (setq n (1+ n))
        )
      )
    )                                        ;end if-1
    (setq data (read-line fd))
  )
  (command "undo" "end")
  (princ)
)                                        ;end fy  


DAT文件的
AAAAAA             1
AAAAA               2
AAAA                 3
AAA                   4
AA                     5
A                       6
EXIT

xyp1964

2. (defun c:tt ()  (setvar "cmdecho" 0)
   
3.   (princ "\n选择文本: ")
   
4.   (if (setq ss (ssget '((0 . "text"))))
   
5.     (progn
   
6.       (setq lst '(("AAAAAA" 1) ("AAAAA" 2) ("AAAA" 3) ("AAA" 4) ("AA" 5)("A" 6) )
   
7.             lst1 (mapcar 'car lst)
   
8.             i         -1
   
9.       )
   
10.       (while (setq s1 (ssname ss (setq i (1+ i))))
    
11.         (setq tx (xyp-DXF 1 s1))
    
12.         (if (setq lst2 (member (strcase tx) lst1))
    
13.           (setq nn (- (length lst) (length lst2))
    
14.                 tx (itoa (cadr (nth nn lst)))
    
15.                 s1 (xyp-SubUpd s1 1 tx)
    
16.           )
    
17.         )
    
18.       )
    
19.     )
    
20.   )
    
21.   (princ)
    
22. )

(defun c:tt ()  (setvar "cmdecho" 0)<br />   (princ "\n选择文本: ")<br />   (if (setq ss (ssget '((0 . "text"))))<br />     (progn<br />       (setq lst '(("AAAAAA" 1) ("AAAAA" 2) ("AAAA" 3) ("AAA" 4) ("AA" 5)("A" 6) )<br />             lst1 (mapcar 'car lst)<br />             i         -1<br />       )<br />       (while (setq s1 (ssname ss (setq i (1+ i))))<br />         (setq tx (xyp-DXF 1 s1))<br />         (if (setq lst2 (member (strcase tx) lst1))<br />           (setq nn (- (length lst) (length lst2))<br />                 tx (itoa (cadr (nth nn lst)))<br />                 s1 (xyp-SubUpd s1 1 tx)<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

dhy

这样只能极限那几个字母，如果我的DAT文件里面有几万个字，你这样就达不到我的替换效果了，我只是举个例子，不是说我DAT文件就一定是AAAAAA .AAAAA .AAAA .AAA .AA .A 这几个字母了，其实我DAT文件里面是个表，有非常多的文字。效果如我2楼的动画，错编辑在那里了。

xyp1964

2. (defun c:tt ()
   
3.   (setvar "cmdecho" 0)
   
4.   (princ "\n选择文本: ")
   
5.   (if (setq ss (ssget '((0 . "text"))))
   
6.     (progn
   
7.       (setq lst (xyp-Txt2List "d:\\数据.dat")
   
8.             lst (mapcar 'xyp-Str2Lst lst)
   
9.             lst1 (mapcar 'car lst)
   
10.             i -1
    
11.       )
    
12.       (while (setq s1 (ssname ss (setq i (1+ i))))
    
13.         (setq tx (xyp-DXF 1 s1))
    
14.         (if (setq lst2 (member (strcase tx) lst1))
    
15.           (setq nn (- (length lst) (length lst2))
    
16.                 tx (cadr (nth nn lst))
    
17.                 s1 (xyp-SubUpd s1 1 tx)
    
18.           )
    
19.         )
    
20.       )
    
21.     )
    
22.   )
    
23.   (princ)
    
24. )

(defun c:tt ()<br />   (setvar "cmdecho" 0)<br />   (princ "\n选择文本: ")<br />   (if (setq ss (ssget '((0 . "text"))))<br />     (progn<br />       (setq lst (xyp-Txt2List "d:\\数据.dat")<br />             lst (mapcar 'xyp-Str2Lst lst)<br />             lst1 (mapcar 'car lst)<br />             i -1<br />       )<br />       (while (setq s1 (ssname ss (setq i (1+ i))))<br />         (setq tx (xyp-DXF 1 s1))<br />         (if (setq lst2 (member (strcase tx) lst1))<br />           (setq nn (- (length lst) (length lst2))<br />                 tx (cadr (nth nn lst))<br />                 s1 (xyp-SubUpd s1 1 tx)<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

dhy

xyp1964 发表于 2014-7-13 17:31

运行部了，显示：选择对象:  ; 错误: no function definition: XYP-TXT2LIST

ZZXXQQ

dhy 发表于 2014-7-14 07:56
运行部了，显示：选择对象:  ; 错误: no function definition: XYP-TXT2LIST

要加载XCAD.vlx

dhy

ZZXXQQ 发表于 2014-7-14 09:01
要加载XCAD.vlx

ZZXXQQ版主，出手帮我完善我原来的那个程序可以吗？真的等着用，谢谢

dhy

没有高手帮我

springwillow

dhy 发表于 2014-7-14 16:54
没有高手帮我

你应该上传一个dat样本，大家才有会针对性。你要的功能应该不难。