[LISP程序]：AutoLISP精选(1)--基于对话框的文字编辑

shisj

AutoLISP精选(1)--基于对话框的文字编辑

〖说明〗
    能对AutoCAD中的TEXT实体（单个或成组）进行编辑，可修改文字
    的字型、高度、宽度、角度、倾角属性，单选时可修改文本串。
    采用DCL对话框界面，使用方便。可运行在AutoCAD R12以上版本，
    DOS或Windows环境均可。
     
〖安装〗
    将"程序代码"一节的文本裁剪下来，保存成名为"DDTXT.LSP"的
    文本文件；将"对话框代码"一节的文本裁剪下来，保存成名为
    "DDTXT.DCL"的文本文件。将这两个文件拷贝到AutoCAD的系统
    目录中。

〖使用〗
    在AutoCAD命令行键入：(load "ddtxt")
    然后执行：ddtxt，按提示选取文本实体（其它实体会自动滤掉）
    余下按对话框提示操作，按OK键确认并修改文本实体。

〖程序代码〗
;;;begain ddtxt.lsp
(defun c:DDTXT (/ olderr oldcmd oldblp ok stytab sty_zh dcl_id
                   ss ent mm sty sty0 hw hw0 wf wf0 ang1 ang10
                   ang2 ang20 txt txt0 txt_n dxf dtr rtd mymain
                   fdzx)

  (defun txterr (s)
    (if (not (member s (list "console break"
                             "Function cancelled"
                             "quit/exit abort")))
        (princ (strcat "\nDDTXT Error:" s))
    )
    (if oldcmd (setvar "cmdecho" oldcmd))
    (if oldblp (setvar "blipmode" oldblp))
    (princ)
  )

  (defun dxf (code elist)(cdr (assoc code elist)))

  (defun rtd (ang)(* (/ ang pi) 180))

  (defun dtr (ang)(/ (* ang pi) 180))

  (defun fdzx (/ sty1 sty2 first tab n sm1 sm2)
    (setq first T stytab '() sty_zh '() n 0)
    (while (setq sty1 (tblnext "STYLE" first))
      (setq tab (cons sty1 tab) first nil)
    );while
    (while (< n (length tab))
      (setq sty1 (nth n tab)
            sty2 (dxf 2 sty1)  
            sm1 (dxf 3 sty1)
            sm2 (dxf 4 sty1)
            stytab (cons sty2 stytab)
      );setq
      (if (and sm2 (/= sm2 ""))
        (setq sty_zh (cons (strcat sty2 "-" sm1 "," sm2) sty_zh))
        (setq sty_zh (cons (strcat sty2 "-" sm1) sty_zh))
      );if
      (setq n (1+ n))
    );while
  );end fdzx

  (defun mymain (/ n)
    (if (> (setq dcl_id (load_dialog "ddtxt")) 0)
      (progn
        (if (new_dialog "modtxt_dia" dcl_id)
          (progn
            (set_tile "hw" hw0)
            (set_tile "wf" wf0)
            (set_tile "ang1" ang10)
            (set_tile "ang2" ang20)
            (if (= txt_n 1)
              (set_tile "sel_ok" txt0)
              (mode_tile "sel_ok" 1)
            )
            (start_list "what")
            (mapcar 'add_list sty_zh)
            (end_list)
            (setq n (- (length stytab)(length (member sty0 stytab))))
            (set_tile "what" (itoa n))

            (action_tile "what" "(setq n(atoi $value))(setq sty(nth n stytab))")
            (action_tile "hw" "(setq hw $value)")
            (action_tile "wf" "(setq wf $value)")
            (action_tile "ang1" "(setq ang1 $value)")
            (action_tile "ang2" "(setq ang2 $value)")
            (action_tile "sel_ok" "(setq txt $value)")
            (action_tile "accept" "(setq ok T)(done_dialog 1)(unload_dialog dcl_id)")
            (action_tile "cancel" "(unload_dialog dcl_id)")

            (start_dialog)
          );progn
          (alert "\nCan't load dialog!")
        );if
      );progn
      (alert "\nCan't load dialog!")
    );if
  );defun

  ;;;main function
  (setq olderr *error* *error* txterr)
  (setq oldcmd (getvar "cmdecho")
        oldblp (getvar "blipmode"))
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (princ "\nSelect Entities: ")
  (setq ss (ssget '((0 . "TEXT"))))
  (if (or (not ss)(= (sslength ss) 0))
    (princ "\nCan't find text entity!")
    (progn
      (setq txt_n (sslength ss))
      (setq ent (entget (ssname ss 0))
            sty0 (dxf 7 ent)
            hw0 (rtos (dxf 40 ent) 2 1)
            wf0 (rtos (dxf 41 ent) 2 1)
            ang10 (rtos (dxf 50 ent) 2 1)
            ang20 (rtos (dxf 51 ent) 2 1)
            txt0 (dxf 1 ent)
      );setq
      (fdzx)
      (mymain)
      (if ok
        (progn
          (if (not sty)(setq sty sty0))
          (if (not wf)(setq wf wf0))
          (if (not hw)(setq hw hw0))
          (if (not ang1)(setq ang1 ang10))
          (if (not ang2)(setq ang2 ang20))
          (setq hw (distof hw 2)
                wf (distof wf 2))
          (if (distof ang1 2)
             (setq ang1 (dtr (distof ang1 2)))
             (setq ang1 nil)
          )
          (if (distof ang2 2)
             (setq ang2 (dtr (distof ang2 2)))
             (setq ang2 nil)
          )

          (if (not wf)(setq wf (distof wf0 2)))
          (if (not hw)(setq hw (distof hw0 2)))
          (if (not ang1)(setq ang1 (dtr(distof ang10 2))))
          (if (not ang2)(setq ang2 (dtr(distof ang20 2))))

          (setq mm 0)
          (while (< mm (sslength ss))
            (setq ent (entget (ssname ss mm))
                  sty0 (dxf 7 ent)
                  hw0 (dxf 40 ent)
                  wf0 (dxf 41 ent)
                  ang10 (dxf 50 ent)
                  ang20 (dxf 51 ent)
                  txt0 (dxf 1 ent)
            );setq
            (if (/= sty0 sty)
              (setq ent (subst(cons 7 sty)(assoc 7 ent) ent))
            )
            (if (/= hw0 hw)
              (setq ent (subst(cons 40 hw)(assoc 40 ent) ent))
            )
            (if (/= wf0 wf)
              (setq ent (subst(cons 41 wf)(assoc 41 ent) ent))
            )
            (if (/= ang1 ang10)
              (setq ent (subst(cons 50 ang1)(assoc 50 ent) ent))
            )
            (if (/= ang2 ang20)
              (setq ent (subst(cons 51 ang2)(assoc 51 ent) ent))
            )
            (if (and (= txt_n 1) txt)
              (setq ent (subst(cons 1 txt)(assoc 1 ent) ent))
            )
            (entmod ent)
            (setq mm (1+ mm))
          );while
        );progn
      );if
    )
  )
  (setq *error* olderr)
  (setvar "blipmode" oldblp)
  (setvar "cmdecho" oldcmd)
  (princ)
)
;;;end ddtxt.lsp

〖对话框代码〗
//begain ddtxt.dcl
dcl_settings : default_dcl_settings { audit_level = 0; }

modtxt_dia : dialog {
    label = "DDTXT V1.0";
    : row {
        : boxed_column {
            label = "Modify";
            : edit_box {
                label = "Height  :";
                key = "hw";
                mnemonic = "H";
                width = 6;
            }
            : edit_box {
                label = "Width   :";
                key = "wf";
                mnemonic = "W";
                width = 6;
            }
            : edit_box {
                label = "Rotation:";
                key = "ang1";
                mnemonic = "R";
                width = 6;
            }
            : edit_box {
                label = "Oblique :";
                key = "ang2";
                mnemonic = "O";
                width = 6;
            }
        }
        : list_box {
            label = "Style:";
            key = "what";
            allow_accept = true;
            width = 25;
            height = 5;
        }
    }
    : spacer {
    }
    : edit_box {
        label = "Text";
        key = "sel_ok";
        mnemonic = "T";
        width = 40;
    }
    : spacer {
    }
    ok_cancel;
}
//end ddtxt.dcl