新作一个写常用文字的程序,命令是ztext

南子

新作一个写字的程序,命令是ztext。欢迎大家试用。
添加新词：在新词的编辑框填写完之后，在其他空间上一点击，
如:在'字高'编辑框点击一下就添加到列表中去了。
如果要大量编辑词库,可以用命令:zedittext
注意:该文本第一列为词库名称,每行的词一"Tab"键分隔.
    可以在r14下调用.


[rar]uploadImages/20023317415011545.rar[/rar]

龙龙仔

有繁体版吗?
E_MAIL: lai_wan_lung@pchome.com.tw

mccad

南子

您有空可以改改。
对话框：

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)
        num  1
        tab  nil
        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_libs  id
                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
)