通用文字编辑-
本帖最后由 myjping 于 2013-9-9 09:38 编辑修改为设置英文切换来CTRL+5
自动检测CAPS LOCK是否打开。
命令结束后切换到英文小写态
双击支持
修改图层改不了的问题
缺点:ddedit 命令会连续进行,但仅第一次双击时会切换输入法
通用文字编辑,借用了网上的一些借码
1.增加了标注及块文字编辑
2.增加了输入法的切换功能
3.设置英文切换来CTRL+5 中文切换为 CTRL+SPACE 我看你们老是要源码,给楼主一点自己的保留好吧。 还能这样太好了 谢谢你的分享,不过最好介绍哈,最好发布源码 顶出源码 内容谢谢楼主分享,CTRL+9是不是有点远了?CTRL+1会不会更方便些呢? 楼主是否公布源码呢? 楼主是否公布源码呢?最好发布源码 关键要有介绍,做点gif图片。。。 能截个图做个介绍时最好的啦 请楼主公布源码,以正视听。相信不会与下面源码相似:
;;; 自定义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:gryz (/ dcl_id1 oba obb
ob1 obn obt ptn otxt txt sty styno
lay cyn layno
hig wid ang col cnu etlst
etlst1 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选择要修改
的任何文本(支持Text,Mtext,块中文字
,属性文字,属性块文字,尺寸文字):"))
(SETQ obn (car ob1)
ptn (car (cdr ob1))
obb (cdr (assoc 0 (entget obn)))
)
(setq obt (car (nentselp ptn)))
(setq oba (cdr (assoc 0 (entget
obt))))
(if (= obb "DIMENSION")
(setq otxt (vl-string-subst""
"\\A1;"(cdr (assoc 1 (entget
obt)))))
)
(if (or
(= oba "TEXT")
(and(/= obb "DIMENSION")(= 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 dclname
(cond
((setq tempname (vl-filename-
mktemp "tt-dcl-tmp.dcl") filen
(open tempname "w"))
(foreach stream
'(
"\n"
"文字修改:dialog {\n"
" label = \"超级文字编辑...\";\n"
" : boxed_radio_column {\n"
"label = \"文字编辑...\";\n"
": edit_box {\n"
" label= \"文字:\";\n"
" key = \"text\";\n"
" edit_width = 50;\n"
"}\n"
": row {\n"
" : popup_list {\n"
" label=\"样式\";\n"
" key = \"sty\";\n"
" edit_width = 13;\n"
" fixed_width = true;\n"
" }\n"
" : edit_box {\n"
" label=\"高度\";\n"
" key = \"hig\";\n"
" edit_width = 7;\n"
" fixed_width = true;\n"
" }\n"
" : edit_box {\n"
" label=\"宽度\";\n"
" key = \"wid\";\n"
" edit_width = 7;\n"
" fixed_width = true;\n"
" }\n"
"}\n"
": row {\n"
" : popup_list {\n"
" label=\"图层\";\n"
" key = \"lay\";\n"
" edit_width = 13;\n"
" fixed_width = true;\n"
" }\n"
" : image_button {\n"
" key = \"col\";\n"
" width= 4;\n"
" aspect_ratio = 0.75;\n"
" fixed_width = true;\n"
" }\n"
" : text_part {\n"
" key = \"cnu\";\n"
" width= 12;\n"
" fixed_width = true;\n"
" }\n"
" : edit_box {\n"
" label=\"角度\";\n"
" key = \"ang\";\n"
" edit_width = 7;\n"
" fixed_width = true;\n"
" }\n"
"}\n"
"spacer_1;\n"
" }\n"
" : row {\n"
"alignment = right;\n"
": spacer {\n"
" width = 1;\n"
" fixed_width = true;\n"
" }\n"
"ok_cancel;\n"
" }\n"
" errtile;\n"
"}\n"
)
(princ stream filen)
)
(close filen)
tempname
)))
(setq dcl_id1 (load_dialog
dclname))
(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))
(setq etlst1 (entget
obn))
(cond ((= oba "ATTDEF")
(setq etlst (subst
(cons 2 txt)
(assoc 2 etlst)
etlst
)))
((= obb "DIMENSION")
(setq etlst1 (subst
(cons 1 txt)
(assoc 1 etlst1)
etlst1
)))
(t
(setq etlst (subst
(cons 1 txt)
(assoc 1 etlst)
etlst
)))
(t nil)
); end cond
(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
(repeat 2
(entmod etlst1)
(entupd obn)
(entmod etlst)
(entupd obt))
;|
(if (= obb "INSERT")
(vla-Regen(vla-get-
activedocument(vlax-get-acad-
object))acActiveViewport)
) |;
)
) ; end if
) ; end if
(if (= 11 (start_dialog))
(Command "_help")
)
) ; end progn
) ; end if
(setq *error* olderr)
(EF:UNDOEnd)
(princ)
(unload_dialog dcl_id1)
(vl-file-delete dclname)
)
;;; end defun
;;***********修改任意文字;完成