本帖最后由 作者 于 2010-7-26 11:38:02 编辑
我发下吧,刚刚改好的。
;;; 自定义UnDo范围 (defun EF:UNDOBegin () (setvar "CMDECHO" 0) (command "_.undo" "_group") (princ) ) ;;; end defun (defun EF:UNDOEnd () (setvar "CMDECHO" 0) (command "_.undo" "_end") (princ) ) ;;; end defun (defun c:tt (/ dcl_id1 oba ob1 obn obt ptn otxt txt sty styno lay cyn layno hig wid ang col cnu etlst style layer ) (graphscr) (EF:UNDOBegin) (setq olderr *error*) (defun *error* (msg) (princ "\n*ERROR*...") (princ msg) (princ) ) ; end defun error. (defun set_color (conm / costr) (defun map_color (ckey mno) (start_image ckey) (fill_image 0 0 (DimX_tile ckey) (DimY_tile ckey) mno) (end_image) ) ; end defun (cond ((= 0 conm) (setq costr "Byblock") ) ((= 1 conm) (setq costr "Red") ) ((= 2 conm) (setq costr "Yellow") ) ((= 3 conm) (setq costr "Green") ) ((= 4 conm) (setq costr "Cyan") ) ((= 5 conm) (setq costr "Bule") ) ((= 6 conm) (setq costr "Magenta") ) ((= 7 conm) (setq costr "color") ) ((= 256 conm) (setq costr "Bylayer") ) (t (setq costr "") ) ) ; end cond (cond ((= 0 col) (map_color "col" 7) ) ((= 256 col) (map_color "col" (cdr (assoc 62 (tblsearch "layer" lay)))) ) (t (map_color "col" conm) ) ) ; end cond (if (= 256 conm) (set_tile "cnu" (strcat "<" (itoa (cdr (assoc 62 (tblsearch "layer" lay ) ) ) ) ">" costr ) ) (set_tile "cnu" (strcat "<" (itoa conm) ">" costr)) ) ; end if
) ; end set_color (defun map_keylist (key keylst) ; set popuplist (start_list key) (mapcar 'add_list keylst ) (end_list) ) ; end map (defun layer_get_all (/ lay layer layname) (setq layer nil ; All layer lay (tblnext "LAYER" T) ) (while (/= lay nil) (setq layname (cdr (assoc 2 lay)) layer (cons layname layer) ) (setq lay (tblnext "LAYER")) ) (setq layer (ACAD_Strlsort layer)) layer ; all layer.
) ; end defun (defun style_get_all (/ sty style sty_list) (setq sty_list nil sty (tblnext "style" t) ) (setq style (cdr (assoc 2 sty))) (while style (if (/= "" style) (setq sty_list (append sty_list (list style) ) ) ) (setq sty (tblnext "style")) (setq style (cdr (assoc 2 sty))) ) ; end while] (setq sty_list (ACAD_Strlsort sty_list)) sty_list ) ; end defun (defun set_error (str) (set_tile "error" str) ) ; end defun (defun sub_mtext (color entlist / ei newlist) (setq ei 0 newlist nil ) (while (< ei (length entlist)) (setq newlist (cons (nth ei entlist) newlist)) (if (= 8 (car (nth ei entlist))) (setq newlist (cons (cons 62 color) newlist)) ) ; end if (setq ei (1+ ei)) ) ; end while (reverse newlist) ) ; end defun (setq ob1 (entsel "\n选择要修改的任何文本:")) (SETQ obn (car ob1) ptn (car (cdr ob1)) ) (setq obt (car (nentselp ptn))) (setq oba (cdr (assoc 0 (entget obt)))) (if (or (= oba "TEXT") (= oba "MTEXT") (= oba "ATTRIB") ) (setq otxt (cdr (assoc 1 (entget obt)))) ) ; end if (if (= oba "ATTDEF") (setq otxt (cdr (assoc 2 (entget obt)))) ) ; end if (if otxt (progn (setq sty (cdr (assoc 7 (entget obt))) lay (cdr (assoc 8 (entget obn))) hig (cdr (assoc 40 (entget obt))) wid (cdr (assoc 41 (entget obt))) ang (cdr (assoc 50 (entget obt))) ) ; end setq (if (or (= oba "TEXT") (= oba "MTEXT") (= oba "ATTRIB") ) (setq col (cdr (assoc 62 (entget obt)))) (setq col (cdr (assoc 62 (entget obn)))) ) ; end if (setq ang (* 180 (/ ang pi))) (if (null col) (progn (setq cyn 0) (setq col 256) ) (setq cyn 1) ) (setq style (style_get_all)) (setq layer (layer_get_all)) (setq styno (- (length style) (length (member sty style)))) (setq layno (- (length layer) (length (member lay layer)))) (setq dcl_id1 (load_dialog "文字修改.DCL")) (if (not (new_dialog "文字修改" dcl_id1)) (exit) ) (set_color col) (set_tile "text" otxt) (set_tile "hig" (rtos hig 2 2)) (set_tile "wid" (rtos wid 2 2)) (set_tile "ang" (rtos ang 2 2)) (mode_tile "text" 2) (map_keylist "sty" style) (set_tile "sty" (itoa styno)) (map_keylist "lay" layer) (set_tile "lay" (itoa layno)) (action_tile "text" "(setq txt $value)") (action_tile "sty" "(setq styno (atoi $value))") (action_tile "hig" "(setq hig (distof $value))(if (>= 0 hig)(progn (mode_tile \"hig\" 3)(mode_tile \"hig\" 2)(set_error \"Input error ! \"))(set_error \"\"))") (action_tile "wid" "(setq wid (distof $value))(if (>= 0 wid)(progn (mode_tile \"wid\" 3)(mode_tile \"wid\" 2)(set_error \"Input error ! \"))(set_error \"\"))") (action_tile "lay" "(setq layno (atoi $value))") (action_tile "col" "(if (setq cnu (ACAD_ColorDlg col))(progn (setq col cnu)(set_color col)))") (action_tile "ang" "(setq ang (distof $value))") (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)")
(if (= 1 (start_dialog)) (if txt (progn (setq sty (nth styno style)) (setq lay (nth layno layer)) (setq ang (* (/ ang 180) pi)) (setq etlst (entget obt)) (if (= oba "ATTDEF") (setq etlst (subst (cons 2 txt) (assoc 2 etlst) etlst ) ) (setq etlst (subst (cons 1 txt) (assoc 1 etlst) etlst ) ) ) ; end if (setq etlst (subst (cons 7 sty) (assoc 7 etlst) etlst ) ) (setq etlst (subst (cons 40 hig) (assoc 40 etlst) etlst ) ) (setq etlst (subst (cons 41 wid) (assoc 41 etlst) etlst ) ) (setq etlst (subst (cons 50 ang) (assoc 50 etlst) etlst ) ) (if (= 1 cyn) (setq etlst (subst (cons 62 col) (assoc 62 etlst) etlst ) ) (if (= "MTEXT" oba) (setq etlst (sub_mtext col etlst)) (setq etlst (cons (cons 62 col) etlst)) ) ; end if ) ; end if (entmod etlst) (entupd obt) (entupd obn) ) ) ; end if ) ; end if (if (= 11 (start_dialog)) (Command "_help") ) ) ; end progn ) ; end if (setq *error* olderr) (EF:UNDOEnd) (princ) ) ;;; end defun
|