ld80721 发表于 2008-8-23 22:10

文字标注替换工具(常用词库提取替换)

帮我看看这个LISP为什么不能在R14下用,2004上能用,但我一直都是用R14.



下面是代码

tz.DCL

tz : dialog{
label="文字替换";
:row {
:column {
:edit_box{
label="文字替换内容:";
width=40;
key="wbnr";}
:row {
:button{
label="添加到本机";
key="wbtj";
fixed_width = true;
width=11;}
:button{
label="从本机删除";
key="wbsc";
fixed_width = true;
width=11;
}
}
}

:list_box{
label="本机已有文字内容:";
list="本机已有文字内容\n";
value="0";
key="wbbc";
width=30;
height=10;}

}
:row{
:button{
label="选择需替换的文本";
key="wbxz";
fixed_width = true;
width=11;}
:cancel_button{
fixed_width=true;
width=11;
}
}
}



tz.lsp

;;;调用菜单
(defun c:tz ()
(setq flag 4)
(setq dcl_id (load_dialog "tz.dcl"))
(if (< dcl_id 0) (exit))
(if (not (new_dialog "tz" dcl_id))
(exit)
)
(setq txtfile (findfile "tz.txt"))
(setq txtlist (Get_Txt txtfile))
(additems "wbbc" txtlist)
(while (> flag 2)
(action_tile "wbtj" "(wbtj)")
(action_tile "wbbc" "(wbbc $value)")
(action_tile "wbsc" "(wbsc)")
(action_tile "wbxz" "(wbxz0)(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq flag (start_dialog))
(if (= flag 1)
(wbxz wbnrn txtlist))
)
(unload_dialog dcl_id)
(princ)
)


;;;把本机上文本添入菜单中
(defun wbtj()
(setq txtlist (append txtlist (list (get_tile"wbnr"))))
(additems "wbbc" txtlist)
)
;;;把本机上文本删除
(defun wbsc()
(setq txtlist (vl-remove wbnrn txtlist))
(additems "wbbc" txtlist)
)
(defun wbbc(vva)
(setq wbnrn (nth (atoi vva) txtlist))
(set_tile "wbnr" wbnrn)
)
(defun wbxz0()
(setq wbnrn (get_tile "wbnr"))
)
(defun wbxz(wbnrn txtlist / ent1 ent2)
(if txtlist
(write_Txt txtfile txtlist)
)
(vl-load-com)
(setq ent1 (vlax-ename->vla-object (car (entsel))))
(setq ent2 (vla-put-textstring ent1 wbnrn))
)

;;将文本文件中的内容转换为列表
(defun Get_Txt (datfile / tmplst x fn)
(setq fn (open datfile "r"))
(while (setq x (read-line fn))
(setq tmplst(append tmplst(list x)))
)
(close fn)
tmplst

zhtonny 发表于 2013-2-12 15:35

学习了:D
页: [1]
查看完整版本: 文字标注替换工具(常用词库提取替换)