|
;;;lsp
(defun findtext(new-str origin-str seltype matype / str-pickset disc-str-x1 disc-str-x2 disc-str-name
disc-str-layer disc-str disc-str-insertp disc-str-height pp1 pp2 pp3 pp4 pp6 k minext-list
maxext-list maxext minext disc-str-sub disc-str-new disc-str-presub i ij iij)
(setvar "cmdecho" 0)(setvar "OSMODE" 0)
(COMMAND "undo" "be")
(if (= seltype 2)
(setq str-pickset (ssget "x" '((0 . "TEXT,MTEXT"))))
(setq str-pickset (ssget '((0 . "TEXT,MTEXT"))))
)
(princ "\n按任意键到下一处﹐右键取代﹐回车结束﹗")
(setq i 0)
(setq k 1)
(setq ij 0)(setq iij 0)
(while (and(< i (sslength str-pickset))(/= k 13))
(if disc-str-x1 (command "erase" disc-str-x1 ""))
(if disc-str-x2 (command "erase" disc-str-x2 ""))
(setq disc-str-name(ssname str-pickset i))
(setq disc-str-layer(cdr(assoc 8 (entget disc-str-name))))
(if (= 0 (cdr(assoc 70 (entget (tblobjname "LAYER" disc-str-layer)))))
(progn
(setq disc-ent(entget disc-str-name))
(setq disc-str(cdr(assoc 1 (entget disc-str-name))))
(setq flags 't)
(cond
((or(= searchtype 1)(= searchtype 2))(setq pos 't))
((= searchtype 3)(if(= 1 matype)
(setq pos(vl-string-search origin-str disc-str))
(setq pos(vl-string-search (strcase origin-str) (strcase disc-str)))
))
)
(if (and flags pos(/= k 13))
(progn
(setq flags nil)
(setq disc-str-insertp(cdr (assoc 10 (entget disc-str-name))))
(setq disc-str-height(cdr (assoc 40 (entget disc-str-name))))
(setq pp1 (polar disc-str-insertp 0.785398 disc-str-height))
(setq pp2 (polar disc-str-insertp 2.35619 disc-str-height))
(setq pp3 (polar disc-str-insertp 3.92699 disc-str-height))
(setq pp4 (polar disc-str-insertp 5.49779 disc-str-height))
(command ".line" pp1 pp3 "")(setq disc-str-x1 (entlast))
(command ".line" pp2 pp4 "")(setq disc-str-x2 (entlast))
(command ".change" disc-str-x1 disc-str-x2 "" "p" "c" 1 "")
(setq minext(vlax-make-safearray vlax-vbdouble '(0 . 2)))
(setq maxext(vlax-make-safearray vlax-vbdouble '(0 . 2)))
(vla-getboundingbox (vlax-ename->vla-object disc-str-name) 'minext 'maxext)
(setq minext-list(vlax-safearray->list minext))
(setq maxext-list(vlax-safearray->list maxext))
(setq pp6 (mapcar '* (mapcar '- maxext-list minext-list) '(2 2 0)))
(command "zoom" "w" (mapcar '- minext-list pp6) (mapcar '+ maxext-list pp6))
(setq ij (1+ ij))
(if (= i (sslength str-pickset)) (setq k 13)(setq k (cadr (grread))))
(if (= k 0)
(progn
(cond
((= searchtype 1)(setq disc-str-new(strcase disc-str))(setq iij (1+ iij)))
((= searchtype 2)(setq disc-str-new(strcase disc-str t))(setq iij (1+ iij)))
((= searchtype 3)
(progn
(setq disc-str-temp disc-str)
(setq origin-len(STRLEN origin-str))
(setq disc-str-new "")
(if (= 1 matype)
(setq pos(vl-string-search origin-str disc-str))
(setq pos(vl-string-search (strcase origin-str) (strcase disc-str)))
)
(while pos
(if (= pos 0)(setq disc-str-presub "")(setq disc-str-presub(substr disc-str 1 pos)))
(setq disc-str-sub(substr disc-str (+ pos 1) origin-len))
(setq disc-str(substr disc-str (+ pos origin-len 1)))
(setq disc-str-new(strcat disc-str-new disc-str-presub new-str))
(entmod disc-ent)
(if (= 1 matype)
(setq pos(vl-string-search origin-str disc-str))
(setq pos(vl-string-search (strcase origin-str) (strcase disc-str)))
)
)
(if (/= nil disc-str) (setq disc-str-new(strcat disc-str-new disc-str)))
)(setq iij (1+ iij)))
)
(setq disc-ent(subst (cons 1 disc-str-new) (assoc 1 (entget disc-str-name)) (entget disc-str-name)))
(entmod disc-ent)
)
)
(if (= 1 matype)
(setq pos(vl-string-search origin-str disc-str))
(setq pos(vl-string-search (strcase origin-str) (strcase disc-str)))
)
)
)
)
)
(setq i(1+ i))
)
(if (or(= i (sslength str-pickset))(= k 0)(= k 13))
(progn
(command "erase" disc-str-x1 "")
(command "erase" disc-str-x2 ""))
)
(if (= ij 0) (alert "Nothing be Found!")(setq tjz-origin-str origin-str))
(princ "\n共选择 " )(princ (sslength str-pickset))(princ " 项﹐ 替换其中 " )(princ iij)(princ " 项!" )
(prompt "\n\n**********J.Z Tang's CONTRIBUTATION**********")
(COMMAND "undo" "e")
(princ)
)
(defun *error* (msg)
(if (or(= (strcase msg) "FUNCTION CANCELLED")(= (strcase msg) "CONSOLE BREAK"))
(progn
(COMMAND "undo" "e")
(command "erase" disc-str-x1 "")
(command "erase" disc-str-x2 "")
)
)
)
(defun c:dr3(/ dd dcl_id )
(setq dcl_id (load_dialog "E:\\LispTool\\vlisp\\Project\\FindText"));;;这句自己改
(new_dialog "FindText" dcl_id)
(setq searchtype 3 seltype 2 matype 1)
(mode_tile "str02" 0)
(mode_tile "str02" 2)
(if new-str (set_tile "str01" new-str))
(if origin-str (set_tile "str02" origin-str))
(action_tile "jz01" "(setq searchtype 1)(mode_tile \"rep\" 1)(mode_tile \"ma\" 1)")
(action_tile "jz02" "(setq searchtype 2)(mode_tile \"rep\" 1)(mode_tile \"ma\" 1)")
(action_tile "jz03" "(setq searchtype 3)(mode_tile \"rep\" 0)(mode_tile \"ma\" 0)(mode_tile \"str02\" 0)(mode_tile \"str02\" 2)")
(if (= "1"(get_tile "jz03")) (progn(setq seltype 1)(setq matype 1)))
(action_tile "sel2" "(setq seltype 1)")
(action_tile "sel1" "(setq seltype 2)")
(action_tile "ma1" "(setq matype 1)")
(action_tile "ma2" "(setq matype 2)")
(action_tile "accept" "(setq new-str(get_tile \"str01\"))(setq origin-str (get_tile \"str02\"))(done_dialog 1)")
(setq dd(start_dialog))
(if (= dd 1)(findtext new-str origin-str seltype matype))
)
//dcl
FindText:dialog{label="查找与替换…";
:column{
:row{
:boxed_radio_column{
label="取代方式";
:radio_button{label="转成大写";key="jz01";}
:radio_button{label="转成小写";key="jz02";}
:radio_button{label="替 换";key="jz03";value="1";}
}
:column{
:boxed_radio_column{
label="取代字符";
key="rep";
:column{
:edit_box{label="搜索字符:";key="str02";edit_width=20;fixed_width=true;}
:edit_box{label="新字符串:";key="str01";edit_width=20;fixed_width=true;}
}
}
:row{
:boxed_radio_column{
label="选取方式";
key="sel";
:radio_button{label="全选"; key="sel1";}
:radio_button{label="手选"; key="sel2";value="1";}
}
:boxed_radio_column{
label="对搜索字符";
key="ma";
:radio_button{label="区分大小写";key="ma1";value="1";}
:radio_button{label="不区分大小写";key="ma2";}
}}
}}
spacer_1;
:row{
fixed_width = true;
alignment = centered;
ok_cancel;
}
}
}
 | 
发表于 2005-7-26 13:12:00
置顶卡
变色卡
显身卡
发表于 2005-7-26 13:22:00
