程序求优化，单行文字 dwg->txt以及txt->dwg
一个可以将单行文字转到记事本里进行编辑，编辑完之后转进cad的程序，但是现在只能以一种字高和行距转回cad，速度貌似也不快，求高手指点;dwg->txt
(defun c:xieru(/ len i name ent pt en l_en txt e1 e2 file_w)
(setq ss (ssget)
ss (j_ssfilter ss 0 "TEXT")
) ;end set
;(open "d://xiechu.txt" "w")
(setq len (sslength ss)
i 0
) ;end set
(repeat len
(setq name (ssname ss i)
ent (entget name)
pt (cdr (assoc 10 ent))
en (cons name pt)
l_en (if en (cons en l_en) l_en)
l_en (vl-sort l_en (function (lambda (e1 e2)(< (cadr (cdr e1)) (cadr (cdr e2))))))
i (1+ i)
) ;end set
) ;end repeat
(setq l_en (reverse l_en))
(setq i 0) (setq en (entget (car (nth i l_en))))
(setq sty (cdr (assoc 7 en))
zg (cdr (assoc 40 en))
tlay (cdr (assoc 8 en))
p_first (cdr (assoc 10 en))
) ;end set
(setq file_w (open "d:\\CAD单行文字编辑.txt" "w"))
(repeat len
(setq en (entget (car (nth i l_en))))
(setq txt (cdr (assoc 1 en)))
(write-line txt file_w)
(setq i (+ i 1))
) ;end repeat
(close file_w)
(startapp "C:\\Windows\\System32\\notepad.exe" "d:\\CAD单行文字编辑.txt")
) ;end fun
;txt->dwg
(defun c:xiechu(/ file_r txt dist pt ptx pty dist i os bool tlast ldata p10 p11 clay)
(setq bool (getstring "原位置或[新位置(X)]"))
(if (OR (= bool "X") (= bool "x"))
(setq p_first (getpoint "选取点")) ;新位
(command "erase" ss "") ;原位
) ;end if
(setq clay (getvar "clayer"))
(setvar "clayer" tlay)
(setq ptx (car p_first)
pty (cadr p_first)
dist (+ (* 1 zg) zg)
) ;end set
(command "-style" "style1" "" "0" "1" "0" "N" "N")
(command "ucs" "w")
(setq file_r (open "d:\\CAD单行文字编辑.txt" "r"))
(setq txt (read-line file_r))
(setq i 0)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(while txt
(setq pt (list ptx (- pty (* i dist))))
(command "text" "s" sty "j" "bl" pt zg "0" txt)
(setq tlast (entlast))
(setq ldata (entget tlast))
(setq p10 (cdr (assoc 10 ldata)))
(setq p11 (cdr (assoc 11 ldata)))
(command "move" tlast "" p10 (polar p10 (angle p10 p11) (distance p10 p11)))
(setq txt (read-line file_r))
(setq i (+ i 1))
) ;end while
(close file_r)
(setvar "osmode" os)
(setvar "clayer" clay)
(command "ucs" "p")
) ;end fun
(defun j_ssfilter (ss num string / len i en)
(setq len (sslength ss) i 0)
(repeat len
(setq en (entget (ssname ss i)))
(if (= (cdr (assoc num en)) string)
(setq i (+ 1 i))
(setq ss (ssdel (ssname ss i) ss))
) ;end if
) ;end repeat
ss
);end fun
(princ)
http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 蒹葭_Keirll的微博 多行文本编辑，明经上已经有很多带对话框的工具，楼主采用TXT文本编辑显得没有必要。
尽管如此还是简化下代码，仅供参考;;dwg->txt
(defun c:xieru (/ ;| len |; i name ent pt en l_en ;| txt e1 e2 |; file_w)
(setq ss (ssget (list (cons 0 "TEXT")))
;_ss (j_ssfilter ss 0 "TEXT")
)
;;end set
;;(open "d://xiechu.txt" "w")
(setq ;| len (sslength ss)|;
i -1
)
;;end set
;_ (repeat len ;_改用while循环,效率略高于repeat和foreach
(while (setq name (ssname ss (setq i (1+ i))))
(setq ;| name (ssname ss i)|;
ent(entget name)
pt (cdr (assoc 10 ent))
en (cons (cdr (assoc 1 ent)) pt) ;_改用直接提取字符串,避免2多次使用entget
l_en ;| (if en ;_空文字时选择不到的 |;
(cons en l_en)
;|l_en)|;
;| ;_排序后置,避免每次加入1个文字重新排序
l_en (vl-sort
l_en
(function
(lambda (e1 e2) (< (cadr (cdr e1)) (cadr (cdr e2))))))
i (1+ i)|;
)
;;end set
)
;;end repeat
;_(setq l_en (reverse l_en));_reverse失去意义,只需要排序倒置
(setq l_en (vl-sort l_en (function (lambda (e1 e2) (> (caddr e1) (caddr e2)))))
l (mapcar (function car) l_en)
p_first (cdar l_en)
ent (entget (caar l_en))
zg (cdr (assoc 40 ent))
tlay (cdr (assoc 8 ent))
)
;|
(setq i 0)
(setq en (entget (car (nth i l_en))))
(setq sty (cdr (assoc 7 en))
zg (cdr (assoc 40 en))
tlay (cdr (assoc 8 en))
p_first (cdr (assoc 10 en))
)|;
;;end set
(setq file_w (open "d:\\CAD单行文字编辑.txt" "w"))
;| (repeat len
(setq en (entget (car (nth i l_en))))
(setq txt (cdr (assoc 1 en)))|;
(while l
(write-line (car l)file_w)
;(setq i (+ i 1))
(setq l (cdr l))
)
;;end repeat
(close file_w)
(startapp "C:\\Windows\\System32\\notepad.exe"
"d:\\CAD单行文字编辑.txt")
)
;;end fun
有问题，写出是好的，写入直接提示
命令:XIECHU 原位置或[新位置(X)]
请回答“是”或“否”。
用户按了<Esc>强制退出是否垂直？[是(Y)/否(N)] <否>:
“style1”是当前文字样式。
然后文字丢失
可以做的更好，在有些场合可能有用 chlh_jd 发表于 2012-9-21 14:29 static/image/common/back.gif
多行文本编辑，明经上已经有很多带对话框的工具，楼主采用TXT文本编辑显得没有必要。
尽管如此还是简化下代 ...
谢谢chlh_jd兄，修改后确实比之前的好很多 xiaxiang 发表于 2012-9-21 15:59 static/image/common/back.gif
有问题，写出是好的，写入直接提示
命令:XIECHU 原位置或[新位置(X)]
请回答“是”或“否”。
谢谢版主的建议。之前弄这个命令主要是想用于总说明的编辑，因为总说明文字很多，而且每行宽度有限值，如果在某行增加几个字的话下面每一行都要改，很不方便，导入到记事本里修改会方便很多 正在找这方面的资料，留个记号学习 下来试下先 下载来试试，应该在某些时候用的上 MARK
页:
[1]