单选更改为多-
下面的代码是修改文字高度，但只有单选对象大家能帮我修改到多选吗？非常感谢。
(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 "\nChoose any textto modify :"))
(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 "tm.DCL"))
(if (not (new_dialog "tm" 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)
(setq etlst (subst (cons 8 lay)(assoc 8 (entget obn)) (entget obn)))
(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
以下是DCL文件
//SUPERDDEDIT
tm: dialog {
label = "Text editing...";
: boxed_radio_column {
label = "Super text editor...";
: edit_box { label= "text:"; key = "text"; edit_width = 50; }
: row {
: popup_list {label="Style"; key = "sty"; edit_width = 13; fixed_width = true;}
: edit_box {label="Height"; key = "hig"; edit_width = 7; fixed_width = true;}
: edit_box {label="Width"; key = "wid"; edit_width = 7; fixed_width = true;}
}
: row {
: popup_list {label="Layer"; key = "lay"; edit_width = 13; fixed_width = true;}
: image_button {key = "col"; width= 4; aspect_ratio = 0.75; fixed_width = true;}
: text_part {key = "cnu"; width= 12;fixed_width = true; }
: edit_box {label="Angle"; key = "ang"; edit_width = 7; fixed_width = true;}
}
spacer_1;
}
: row {
alignment = right;
: spacer {width = 1; fixed_width = true;}
ok_cancel;
}
errtile;
} 你们只需要使用一个while循环，所以只要在屏幕上选择任何并没有什么可以退出的地方
(while (/= (setq ob1 (entsel "\nChoose any textto modify :")) nil)
your code
....find the correct spot in your code
) ; end while
加载错误 谁能帮我？ flyfox1047，
上传对话框文件tm。dcl，如果你想让我们帮助你。
ymg公司
非常感谢。已补充 flyfox1047，
我真的不认为这样做有什么意义。
您可以通过更改属性来完成同样的操作，而不用使用Lisp的这一部分。
例如，选择所需数量的文字实体，夹点将打开。发出命令ch
现在，在属性框中，可以更改高度和样式。
修改该程序类似于重新创建该功能。
ymg公司
页:
[1]