程序求优化，单行文字 dwg->txt以及txt->dwg

蒹葭_Keirll

一个可以将单行文字转到记事本里进行编辑，编辑完之后转进cad的程序，但是现在只能以一种字高和行距转回cad，速度貌似也不快，求高手指点

2. ;dwg->txt
   
3. (defun c:xieru(/ len i name ent pt en l_en txt e1 e2 file_w)
   
4.   (setq ss (ssget)
   
5.         ss (j_ssfilter ss 0 "TEXT")
   
6.   ) ;end set
   
7.   ;(open "d://xiechu.txt" "w")
   
8.   (setq len (sslength ss)
   
9.         i 0
   
10.   ) ;end set
    
11.   (repeat len
    
12.     (setq name (ssname ss i)
    
13.     ent (entget name)
    
14.     pt (cdr (assoc 10 ent))
    
15.     en (cons name pt)
    
16.     l_en (if en (cons en l_en) l_en)
    
17.     l_en (vl-sort l_en (function (lambda (e1 e2)(< (cadr (cdr e1)) (cadr (cdr e2))))))
    
18.     i (1+ i)
    
19.     ) ;end set
    
20.   ) ;end repeat
    
21.   (setq l_en (reverse l_en))
    
22.   (setq i 0) (setq en (entget (car (nth i l_en))))
    
23.   (setq sty (cdr (assoc 7 en))
    
24.         zg (cdr (assoc 40 en))
    
25.         tlay (cdr (assoc 8 en))
    
26.         p_first (cdr (assoc 10 en))
    
27.   ) ;end set
    
28.   (setq file_w (open "d:\\CAD单行文字编辑.txt" "w"))
    
29.   (repeat len
    
30.     (setq en (entget (car (nth i l_en))))
    
31.     (setq txt (cdr (assoc 1 en)))
    
32.     (write-line txt file_w)
    
33.     (setq i (+ i 1))
    
34.   ) ;end repeat
    
35.   (close file_w)
    
36.   (startapp "C:\\Windows\\System32\\notepad.exe" "d:\\CAD单行文字编辑.txt")
    
37. ) ;end fun
    
38. 
    
39. ;txt->dwg
    
40. (defun c:xiechu(/ file_r txt dist pt ptx pty dist i os bool tlast ldata p10 p11 clay)
    
41.   (setq bool (getstring "原位置或[新位置(X)]"))
    
42.   (if (OR (= bool "X") (= bool "x"))
    
43.     (setq p_first (getpoint "选取点")) ;新位
    
44.     (command "erase" ss "") ;原位
    
45.   ) ;end if
    
46.   (setq clay (getvar "clayer"))
    
47.   (setvar "clayer" tlay)
    
48.   (setq ptx (car p_first)
    
49.         pty (cadr p_first)
    
50.         dist (+ (* 1 zg) zg)
    
51.   ) ;end set
    
52.   (command "-style" "style1" "" "0" "1" "0" "N" "N")
    
53.   (command "ucs" "w")
    
54.   (setq file_r (open "d:\\CAD单行文字编辑.txt" "r"))
    
55.   (setq txt (read-line file_r))
    
56.   (setq i 0)
    
57.   (setq os (getvar "osmode"))
    
58.   (setvar "osmode" 0)
    
59.   (while txt
    
60.     (setq pt (list ptx (- pty (* i dist))))
    
61.     (command "text" "s" sty "j" "bl" pt zg "0" txt)
    
62.     (setq tlast (entlast))
    
63.     (setq ldata (entget tlast))
    
64.     (setq p10 (cdr (assoc 10 ldata)))
    
65.     (setq p11 (cdr (assoc 11 ldata)))
    
66.     (command "move" tlast "" p10 (polar p10 (angle p10 p11) (distance p10 p11)))
    
67.     (setq txt (read-line file_r))
    
68.     (setq i (+ i 1))
    
69.   ) ;end while
    
70.   (close file_r)
    
71.   (setvar "osmode" os)
    
72.   (setvar "clayer" clay)
    
73.   (command "ucs" "p")
    
74. ) ;end fun
    
75. 
    
76. 
    
77. (defun j_ssfilter (ss num string / len i en)
    
78.   (setq len (sslength ss) i 0)
    
79.   (repeat len
    
80.     (setq en (entget (ssname ss i)))
    
81.     (if (= (cdr (assoc num en)) string)
    
82.       (setq i (+ 1 i))
    
83.       (setq ss (ssdel (ssname ss i) ss))
    
84.      ) ;end if
    
85.   ) ;end repeat
    
86.   ss
    
87. );end fun
    
88. (princ)
    

;dwg->txt<br /> (defun c:xieru(/ len i name ent pt en l_en txt e1 e2 file_w)<br />   (setq ss (ssget)<br />         ss (j_ssfilter ss 0 "TEXT")<br />   ) ;end set<br />   ;(open "d://xiechu.txt" "w")<br />   (setq len (sslength ss)<br />         i 0<br />   ) ;end set<br />   (repeat len<br />     (setq name (ssname ss i)<br />     ent (entget name)<br />     pt (cdr (assoc 10 ent))<br />     en (cons name pt)<br />     l_en (if en (cons en l_en) l_en)<br />     l_en (vl-sort l_en (function (lambda (e1 e2)(< (cadr (cdr e1)) (cadr (cdr e2))))))<br />     i (1+ i)<br />     ) ;end set<br />   ) ;end repeat<br />   (setq l_en (reverse l_en))<br />   (setq i 0) (setq en (entget (car (nth i l_en))))<br />   (setq sty (cdr (assoc 7 en))<br />         zg (cdr (assoc 40 en))<br />         tlay (cdr (assoc 8 en))<br />         p_first (cdr (assoc 10 en))<br />   ) ;end set<br />   (setq file_w (open "d:\\CAD单行文字编辑.txt" "w"))<br />   (repeat len<br />     (setq en (entget (car (nth i l_en))))<br />     (setq txt (cdr (assoc 1 en)))<br />     (write-line txt file_w)<br />     (setq i (+ i 1))<br />   ) ;end repeat<br />   (close file_w)<br />   (startapp "C:\\Windows\\System32\\notepad.exe" "d:\\CAD单行文字编辑.txt")<br /> ) ;end fun<br /> <br /> ;txt->dwg<br /> (defun c:xiechu(/ file_r txt dist pt ptx pty dist i os bool tlast ldata p10 p11 clay)<br />   (setq bool (getstring "原位置或[新位置(X)]"))<br />   (if (OR (= bool "X") (= bool "x"))<br />     (setq p_first (getpoint "选取点")) ;新位<br />     (command "erase" ss "") ;原位<br />   ) ;end if<br />   (setq clay (getvar "clayer"))<br />   (setvar "clayer" tlay)<br />   (setq ptx (car p_first)<br />         pty (cadr p_first)<br />         dist (+ (* 1 zg) zg)<br />   ) ;end set<br />   (command "-style" "style1" "" "0" "1" "0" "N" "N")<br />   (command "ucs" "w")<br />   (setq file_r (open "d:\\CAD单行文字编辑.txt" "r"))<br />   (setq txt (read-line file_r))<br />   (setq i 0)<br />   (setq os (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (while txt<br />     (setq pt (list ptx (- pty (* i dist))))<br />     (command "text" "s" sty "j" "bl" pt zg "0" txt)<br />     (setq tlast (entlast))<br />     (setq ldata (entget tlast))<br />     (setq p10 (cdr (assoc 10 ldata)))<br />     (setq p11 (cdr (assoc 11 ldata)))<br />     (command "move" tlast "" p10 (polar p10 (angle p10 p11) (distance p10 p11)))<br />     (setq txt (read-line file_r))<br />     (setq i (+ i 1))<br />   ) ;end while<br />   (close file_r)<br />   (setvar "osmode" os)<br />   (setvar "clayer" clay)<br />   (command "ucs" "p")<br /> ) ;end fun<br /> <br /> <br /> (defun j_ssfilter (ss num string / len i en)<br />   (setq len (sslength ss) i 0)<br />   (repeat len<br />     (setq en (entget (ssname ss i)))<br />     (if (= (cdr (assoc num en)) string)<br />       (setq i (+ 1 i))<br />       (setq ss (ssdel (ssname ss i) ss))<br />      ) ;end if<br />   ) ;end repeat<br />   ss<br /> );end fun<br /> (princ)<br />

该贴已经同步到 蒹葭_Keirll的微博

chlh_jd

多行文本编辑，明经上已经有很多带对话框的工具，楼主采用TXT文本编辑显得没有必要。
尽管如此还是简化下代码，仅供参考

2. ;;dwg->txt
   
3. (defun c:xieru        (/ ;| len |; i name ent pt en l_en ;| txt e1 e2 |; file_w)
   
4.   (setq        ss (ssget (list (cons 0 "TEXT")))
   
5.         ;_ss (j_ssfilter ss 0 "TEXT")
   
6.         )
   
7.   ;;end set
   
8.   ;;(open "d://xiechu.txt" "w")
   
9.   (setq        ;| len (sslength ss)|;
   
10.         i   -1
    
11.         )
    
12.   ;;end set
    
13.   ;_ (repeat len ;_改用while循环,效率略高于repeat和foreach
    
14.   (while (setq name (ssname ss (setq i (1+ i))))
    
15.     (setq ;| name (ssname ss i)|;
    
16.           ent  (entget name)
    
17.           pt   (cdr (assoc 10 ent))
    
18.           en   (cons (cdr (assoc 1 ent)) pt) ;_改用直接提取字符串,避免2多次使用entget
    
19.           l_en ;| (if en ;_空文字时选择不到的 |;
    
20.                  (cons en l_en)
    
21.                 ;|  l_en)|;
    
22.           ;| ;_排序后置,避免每次加入1个文字重新排序
    
23.           l_en (vl-sort
    
24.                  l_en
    
25.                  (function
    
26.                    (lambda (e1 e2) (< (cadr (cdr e1)) (cadr (cdr e2))))))
    
27.           i    (1+ i)|;
    
28.           )
    
29.     ;;end set
    
30.     )
    
31.   ;;end repeat
    
32.   ;_(setq l_en (reverse l_en));_reverse失去意义,只需要排序倒置
    
33.   (setq l_en (vl-sort l_en (function (lambda (e1 e2) (> (caddr e1) (caddr e2)))))       
    
34.         l (mapcar (function car) l_en)
    
35.         p_first (cdar l_en)
    
36.         ent (entget (caar l_en))
    
37.         zg (cdr (assoc 40 ent))
    
38.         tlay        (cdr (assoc 8 ent))
    
39.         )
    
40.        
    
41.   ;|
    
42.   (setq i 0)
    
43.   (setq en (entget (car (nth i l_en))))
    
44.   (setq        sty        (cdr (assoc 7 en))
    
45.         zg        (cdr (assoc 40 en))
    
46.         tlay        (cdr (assoc 8 en))
    
47.         p_first        (cdr (assoc 10 en))
    
48.         )|;
    
49.   ;;end set
    
50.   (setq file_w (open "d:\\CAD单行文字编辑.txt" "w"))
    
51.   ;| (repeat len
    
52.     (setq en (entget (car (nth i l_en))))
    
53.     (setq txt (cdr (assoc 1 en)))|;
    
54.   (while l
    
55.     (write-line (car l)  file_w)
    
56.     ;(setq i (+ i 1))
    
57.     (setq l (cdr l))
    
58.     )
    
59.   ;;end repeat
    
60.   (close file_w)
    
61.   (startapp "C:\\Windows\\System32\\notepad.exe"
    
62.             "d:\\CAD单行文字编辑.txt")
    
63.   )
    
64. ;;end fun
    

;;dwg->txt<br /> (defun c:xieru        (/ ;| len |; i name ent pt en l_en ;| txt e1 e2 |; file_w)<br />   (setq        ss (ssget (list (cons 0 "TEXT")))<br />         ;_ss (j_ssfilter ss 0 "TEXT")<br />         )<br />   ;;end set<br />   ;;(open "d://xiechu.txt" "w")<br />   (setq        ;| len (sslength ss)|;<br />         i   -1<br />         )<br />   ;;end set<br />   ;_ (repeat len ;_改用while循环,效率略高于repeat和foreach <br />   (while (setq name (ssname ss (setq i (1+ i))))<br />     (setq ;| name (ssname ss i)|;<br />           ent  (entget name)<br />           pt   (cdr (assoc 10 ent))<br />           en   (cons (cdr (assoc 1 ent)) pt) ;_改用直接提取字符串,避免2多次使用entget<br />           l_en ;| (if en ;_空文字时选择不到的 |;<br />                  (cons en l_en)<br />                 ;|  l_en)|;<br />           ;| ;_排序后置,避免每次加入1个文字重新排序<br />           l_en (vl-sort<br />                  l_en<br />                  (function<br />                    (lambda (e1 e2) (< (cadr (cdr e1)) (cadr (cdr e2))))))<br />           i    (1+ i)|;<br />           )<br />     ;;end set<br />     )<br />   ;;end repeat<br />   ;_(setq l_en (reverse l_en));_reverse失去意义,只需要排序倒置<br />   (setq l_en (vl-sort l_en (function (lambda (e1 e2) (> (caddr e1) (caddr e2)))))        <br />         l (mapcar (function car) l_en)<br />         p_first (cdar l_en)<br />         ent (entget (caar l_en))<br />         zg (cdr (assoc 40 ent))<br />         tlay        (cdr (assoc 8 ent))<br />         )<br />         <br />   ;|<br />   (setq i 0)<br />   (setq en (entget (car (nth i l_en))))<br />   (setq        sty        (cdr (assoc 7 en))<br />         zg        (cdr (assoc 40 en))<br />         tlay        (cdr (assoc 8 en))<br />         p_first        (cdr (assoc 10 en))<br />         )|;<br />   ;;end set<br />   (setq file_w (open "d:\\CAD单行文字编辑.txt" "w"))<br />   ;| (repeat len <br />     (setq en (entget (car (nth i l_en))))<br />     (setq txt (cdr (assoc 1 en)))|;<br />   (while l<br />     (write-line (car l)  file_w)<br />     ;(setq i (+ i 1))<br />     (setq l (cdr l))<br />     )<br />   ;;end repeat<br />   (close file_w)<br />   (startapp "C:\\Windows\\System32\\notepad.exe"<br />             "d:\\CAD单行文字编辑.txt")<br />   )<br /> ;;end fun<br />

xiaxiang

有问题，写出是好的，写入直接提示
命令:  XIECHU 原位置或[新位置(X)]
请回答“是”或“否”。
用户按了<Esc>强制退出是否垂直？[是(Y)/否(N)] <否>:
“style1”是当前文字样式。
然后文字丢失
可以做的更好，在有些场合可能有用

蒹葭_Keirll

chlh_jd 发表于 2012-9-21 14:29
多行文本编辑，明经上已经有很多带对话框的工具，楼主采用TXT文本编辑显得没有必要。
尽管如此还是简化下代 ...

谢谢chlh_jd兄，修改后确实比之前的好很多

蒹葭_Keirll

xiaxiang 发表于 2012-9-21 15:59
有问题，写出是好的，写入直接提示
命令:  XIECHU 原位置或[新位置(X)]
请回答“是”或“否”。

谢谢版主的建议。之前弄这个命令主要是想用于总说明的编辑，因为总说明文字很多，而且每行宽度有限值，如果在某行增加几个字的话下面每一行都要改，很不方便，导入到记事本里修改会方便很多

adc

正在找这方面的资料，留个记号学习

jyzas

下来试下先

yaokui25

下载来试试，应该在某些时候用的上

ylileiy

MARK