新作一个写常用文字的程序,命令是ztext
本帖最后由 作者 于 2002-3-3 17:41:59 编辑新作一个写字的程序,命令是ztext。欢迎大家试用。
添加新词:在新词的编辑框填写完之后,在其他空间上一点击,
如:在'字高'编辑框点击一下就添加到列表中去了。
如果要大量编辑词库,可以用命令:zedittext
注意:该文本第一列为词库名称,每行的词一"Tab"键分隔.
可以在r14下调用.
uploadImages/20023317415011545.rar
有繁体版吗?
有繁体版吗?E_MAIL: lai_wan_lung@pchome.com.tw
看来以后程序都应该增加繁体版及英文版才行 :)
已经把源代码给上传明经下载中心了
您有空可以改改。对话框:
dcl_settings : default_dcl_settings { audit_level = 3; }
ztext : dialog {
label="XZ";
: popup_list {
label = "词库";
key = "libs";
edit_width = 10;
fixed_width = true;
fixed_height = false;
}
: list_box {
key = "libword";
width = 20;
fixed_width = true;
height = 15;
is_default=true;
}
: edit_box {
label = "字高";
key = "height";
edit_width = 10;
width = 10;
fixed_width = true;
}
: popup_list {
label = "字型";
key = "style";
edit_width = 10;
width = 5;
fixed_width = true;
}
: edit_box {
label = "新词";
key = "new";
edit_width = 10;
width = 10;
fixed_width = true;
}
: button {
label = "南子休息";
key = "cancel";
// is_default = true;
is_cancel = true;
fixed_width = true;
alignment=centered;
}
}
程序段:
(defun tabstr (tab / num str)
(setq
str (apply 'strcat
(mapcar '(lambda (x) (strcat x "\t")) tab)
)
)
(substr str 1 (- (strlen str) 1)) ; _ 结束repeat
)
;;;(tabstr '("1" "2" "3" "4"))
(defun strtab (str / len num tab str1 s)
(setvar "cmdecho" 0)
(setq len(strlen str)
num1
tabnil
str1 ""
) ; _ end of setq
(while (< num (+ 1 len))
(setq s (substr str num 1))
(cond
((= "\t" s)
(setq tab(cons str1 tab)
num(+ 1 num)
str1 ""
) ; _ end of setq
)
(T
(setq str1 (strcat str1 s)
num(+ 1 num)
) ; _ end of setq
)
)
(if (> num len)
(setq tab (cons str1 tab))
)
) ; _ end of while
(reverse tab)
)
(defun tab_to_str (tab / len num str)
(setq str (apply 'strcat
(mapcar '(lambda (x) (strcat x " ")) tab)
)
)
(substr str 1 (- (strlen str) 1))
)
(defun str_to_tab
(str sym / len num tmp len0 len1 a d_len pick pick_list)
(setq len (strlen str))
(setq num 1
tmp num
) ; _ end of setq
(setq len0 len)
(setq pick_list nil)
(repeat len
(setq a (substr str num 1))
(if (= sym a)
(progn
(setq len1 (strlen (substr str num)))
(setq d_len (- len0 len1))
(setq pick (substr str tmp d_len))
(setq pick_list (cons pick pick_list))
(setq num (+ 1 num))
(setq tmp num)
(setq len0 (- len1 1))
) ; _ end of progn
(if (= len num)
(progn
(setq num (+ 1 num))
(setq pick (substr str tmp))
(setq pick_list (cons pick pick_list))
) ; _ end of progn
(setq num (+ 1 num))
) ; _ end of if
) ; _ end of if
) ; _ end of repeat
(setq pick_list (reverse pick_list))
)
;;;(progn (setq f (open "c:\\ztext.xz" "w"))(princ "" f)(close f))
(defun c:ztext (/ dcl_id filename ztext_styles
ztext_records ztext_libsid
dd in os ZTEXT_TEXT
)
(defun ztext_saverecords (filename ztext_records / F STRRECORDS)
(setq strrecords
(apply 'strcat
(mapcar '(lambda (x) (strcat (tabstr x) "\n"))
(reverse ztext_records)
)
)
)
(setq strrecords (substr strrecords 1 (- (strlen strrecords) 1)))
(setq f (open filename "w"))
(princ strrecords f)
(close f)
(princ)
)
(defun ztext_new (key value reason)
(setq ztext_lib (nth (read (get_tile "libs")) ztext_libs))
(if (and (/= "" value)
(= reason 2)
(not (member value
(cdr (assoc ztext_lib
ztext_records
)
)
)
)
)
(progn
(setq ztext_records
(subst
(cons
ztext_lib
(cons value
(cdr (assoc ztext_lib
ztext_records
)
)
)
)
(assoc ztext_lib
ztext_records
)
ztext_records
)
)
(start_list "libword" 3)
(mapcar 'add_list
(cdr (assoc ztext_lib
ztext_records
)
)
)
(end_list)
)
)
)
;;;(zgetstylenames)
(defun zgetstylenames (/ style stylename0 stylenames)
(setq style (tblnext "style" t))
(if style
(setq stylename0 (cdr (assoc 2 style)))
)
(while (setq style (tblnext "style"))
(setq stylenames (cons (cdr (assoc 2 style)) stylenames))
)
(setq stylenames (cons stylename0 stylenames))
)
(defun ztext_REMOVE (ele lst) ; by Serge Volkov
(apply 'append (subst nil (list ele) (mapcar 'list lst)))
)
(defun c:zedittext()
(alert "编辑文件时请用'Tab'键做分隔符\n每行的第一个字符串为词库名称")
(command "shell" "notepad.exe c:\\ztext.xz"))
;;;(defun Zgetstyles (/ styles)
;;;(vl-load-com)
;;;(vlax-for x
;;; (vlax-get (vla-get-activedocument (vlax-get-acad-object))
;;; "TextStyles"
;;; )
;;; (setq styles (cons (vlax-get x "name") styles))
;;;)
;;;)
(defun zgetfilerecords (filename / f readme text ztext_records)
(if (findfile filename)
(progn
(setq f (open filename "r"))
(while (setq readme (read-line f))
(if (/= "" readme)
(setq ztext_records (cons (strtab readme) ztext_records))
)
)
(close f)
)
)
ztext_records
)
(defun ztext_libword (key value reason / IN OS)
(setq ztext_lib (nth (read (get_tile "libs")) ztext_libs))
(if (cdr (assoc ztext_lib
ztext_records
)
)
(setq
ztext_text
(nth (read value)
(cdr (assoc ztext_lib
ztext_records
)
)
)
)
(setq ztext_text nil)
)
(cond
((= 1 reason) (setq ztext_dclpos (done_dialog 1)))
;;; ((= 4 reason)
;;; (progn
;;; (setq ztext_records
;;; (subst
;;; (cons
;;; ztext_lib
;;; (ztext_REMOVE ztext_text
;;; (cdr (assoc ztext_lib
;;; ztext_records
;;; )
;;; )
;;; )
;;; )
;;; (assoc ztext_lib
;;; ztext_records
;;; )
;;; ztext_records
;;; )
;;; )
;;; (start_list "libword" 3)
;;; (mapcar (function add_list)
;;; (cdr (assoc ztext_lib
;;; ztext_records
;;; )
;;; )
;;; )
;;; (end_list)
;;; )
;;; )
)
)
(defun ztext_selectlibs (key value)
(setq ztext_lib (nth (read value) ztext_libs))
(start_list "libword" 3)
(mapcar 'add_list
(cdr (assoc ztext_lib
ztext_records
)
)
)
(end_list)
)
(setq filename "c:\\ztext.xz")
(setq ztext_styles (Zgetstylenames))
(setq ztext_records (zgetfilerecords filename))
(if (not ztext_records)
(setq ztext_records
'(("通用词库")
("南子" "单元" "楼梯" "阳台")
("用户1")
("用户2")
("用户3")
("用户4")
("用户5")
)
)
)
(setq ztext_libs (mapcar 'car ztext_records))
(setq ztext_dclpos '(-1 -1))
;;;(unload_dialog id)
(if (< (setq id
(load_dialog "ztext.dcl")
) ;_ end of setq
0
) ;_ end of <
(exit)
)
(setq dd 1)
(while (> dd 0)
(if (not (new_dialog "ztext" id "" ztext_dclpos))
(exit)
)
(if (and ztext_height
(= 'STR (type ztext_height))
(numberp (read ztext_height))
)
(set_tile "height" ztext_height)
(set_tile "height" (setq ztext_height "0.4"))
) ;_ end of if
(progn (start_list "style" 3)
(mapcar 'add_list ztext_styles)
(end_list)
)
(setq ztext_style (nth (read (get_tile "style")) ztext_styles))
(progn (start_list "libs" 3)
(mapcar 'add_list ztext_libs)
(end_list)
)
(if (not ztext_lib)
(setq ztext_lib "通用词库")
)
(set_tile "libs"
(itoa (- (length ztext_libs)
(length (member ztext_lib ztext_libs))
)
)
)
(progn (start_list "libword" 3)
(mapcar 'add_list
(cdr (assoc ztext_lib
ztext_records
)
)
)
(end_list)
)
(action_tile
"style"
"(setq ztext_style (nth (read $value) ztext_styles))"
)
(action_tile
"height"
"(setq ztext_height (if (read $value) $value \"0.4\"))"
)
(action_tile "cancel" "(setq ztext_dclpos (done_dialog 0))")
(action_tile
"libword"
"(ztext_libword $key $value $reason)"
)
(action_tile "new" "(ztext_new $key $value $reason)")
(action_tile "libs" "(ztext_selectlibs $key $value)")
(setq dd (start_dialog))
(cond ((= 0 dd) (ztext_saverecords filename ztext_records))
(t
(if ztext_text
(progn
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq in (getpoint "\n 请选择文字位置:"))
(setvar "osmode" os)
(if in
(entmake
(list '(0 . "TEXT")
(cons 8 (getvar "clayer"))
;;; (cons 62
;;; (cond ((= "BYLAYER" (getvar "cecolor")) 256)
;;; ((= "BYBLOCK" (getvar "cecolor")) 0)
;;; (t (atoi (getvar "cecolor")))
;;; )
;;; )
'
(10 0.000 0.000 0.000)
(cons 40 (atof ztext_height))
(cons 50 0.0)
(cons 1 ztext_text)
(cons 7 ztext_style)
'(71 . 0)
'(72 . 1)
'(73 . 0)
(cons 11 in)
'(210 0.000 0.000 0.000)
)
)
(progn (setq dd 0)
(ztext_saverecords filename ztext_records)
)
)
)
)
)
)
(princ)
) ;_ end of while
)
页:
[1]