文字列を別の文字列で置換するAutoLISPコマンドです。
過去の置換設定の履歴は記憶されます。
部分的に一致する文字列があれば置換を実行するのか、文字列全体が一致して初めて置換を実行するのかを選択できます。
;文字置換
(defun c:SD_703 ( / ObjSet dcl_id j m Data DataType Contents Position t1
NewL NewString SWordLen SubText PositionL NewContents
OrgStrLen mm Answer TransText LastContents TxtStr1 TxtStr2 lst1 lst2 lst3)
(if (= SD:Lang "E")
(princ "\n [SD_703 ver.20220904] Replace Text. Press [F1] for help")
(princ "\n [SD_703 ver.20220904] ただの文字置換。 [F1]で使い方説明")
)
(princ "\n **********************************")
(load "SD_U")
(load "SD_103")
(setq *error* *myerror*)
(OpeningRoutine)
(setfunhelp "C:SD_703" "https://www.offshorecad.com.ph/speeddraft/blog/sd_703/")
(setq AcadVersion (getvar "acadver"))
(setq ObjSet (ssget '((-4 . "<OR")(0 . "TEXT")(0 . "MTEXT")(-4 . "<AND")(0 . "INSERT")(66 . 1)(-4 . "AND>")(-4 . "OR>"))))
;ダイアログ呼び出し
(setq dcl_id (load_dialog "SD_703.dcl"))
(if (= SD:Lang "E")
(new_dialog "ReplaceTexts" dcl_id)
(new_dialog "ReplaceTexts_J" dcl_id)
)
(RegistryRead_703)
(setq lst1 (SpaceText->list_ddedit TxtStr1))
(setq lst2 (SpaceText->list_ddedit TxtStr2))
(setq lst3 (mapcar '(lambda (x y)(strcat x " -> " y)) lst1 lst2))
(start_list "pl1")
(mapcar ' add_list lst3)
(end_list)
(action_tile "pl1" "(set_tile \"SearchWord\" (nth (atoi $value) lst1))(set_tile \"Replacement\" (nth (atoi $value) lst2))") (action_tile "accept" "(get_data_703)(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(action_tile "help" "(startapp \"explorer\" \"https://www.offshorecad.com.ph/speeddraft/blog/sd_703/\")")
(setq Act (start_dialog))
(unload_dialog dcl_id)
(if (= Act 0) (exit))
(member SWord lst1)(member RWord lst2)
(if (null (and (member SWord lst1)(member RWord lst2)))
(progn
(if (>= (length lst1) 20)
(setq lst1 (reverse (cdr (reverse lst1))))
)
(setq lst1 (append (list SWord) lst1)
TxtStr1 (mapcar '(lambda (x) (strcat x ";")) lst1)
TxtStr1 (apply 'strcat TxtStr1)
TxtStr1 (vl-string-right-trim ";" TxtStr1))
(if (>= (length lst2) 20)
(setq lst2 (reverse (cdr (reverse lst2))))
)
(setq lst2 (append (list RWord) lst2)
TxtStr2 (mapcar '(lambda (x) (strcat x ";")) lst2)
TxtStr2 (apply 'strcat TxtStr2)
TxtStr2 (vl-string-right-trim ";" TxtStr2))
(Write_Registry_703)))
(setq j 0 m (sslength ObjSet)) ;iは選択した文字を移動、mは選択した文字の総数
(repeat m
(setq Data (entget (ssname ObjSet j)))
(setq DataType (SD3511 0 (ssname ObjSet j)))
(cond ((= DataType "INSERT")
(setq List1 (InsideAttribList (ssname ObjSet j)))
(foreach item List1
(if (= (car item) "ATTRIB")
(progn
(setq Data (entget (cadr item))
Contents (SD3511 1 Data)
)
(setq Position nil)
(if (null (and (= t1 "1")(/= Contents SWord)))(Procedure_703))
(entupd (cadr item))
)
)
)
)
(T
(setq Contents (SD3511 1 Data))
(setq Position nil)
(if (null (and (= t1 "1")(/= Contents SWord)))(Procedure_703))
)
)
(setq j (1+ j))
)
(ClosingRoutine)
(setq *error* nil)
(princ)
)
(defun Procedure_703()
(cond ;検索文字が1byte1文字、大文字小文字区別
((and SWord (=(strlen SWord) 1)(vl-position SWord (StringToList Contents))(= UpperLower "1" ))
(setq NewL (subst RWord SWord (StringToList Contents)))
(setq NewString (ListToString NewL))
(setq Data (subst (cons 1 NewString) (assoc 1 Data) Data))
(entmod Data)
)
;検索文字が1byte1文字、大文字小文字区別せず。１回目で大文字を、２回目に小文字を$に仮変換し最後に再変換
((and SWord (=(strlen SWord) 1)(vl-position (strcase SWord T) (StringToList (strcase Contents T)))(= UpperLower "0" ))
(setq NewL (subst "$" (strcase SWord T) (StringToList Contents)))
(setq NewL (subst "$" (strcase SWord) NewL))
(setq NewL (subst RWord "$" NewL))
(setq NewString (ListToString NewL))
(setq Data (subst (cons 1 NewString) (assoc 1 Data) Data))
(entmod Data)
)
;検索文字が2文字以上、大文字小文字区別
((and SWord (/=(strlen SWord) 1)(vl-string-search SWord Contents)(= UpperLower "1" ))
(if (vl-string-search SWord Contents)(progn
(setq Contents (vl-string-subst RWord SWord Contents))
(setq Data (subst (cons 1 Contents) (assoc 1 Data) Data))
(entmod Data))
)
)
;検索文字が2文字以上、大文字小文字区別しない（一番難しい）
((and SWord (/=(strlen SWord) 1)(vl-string-search (strcase SWord T) (strcase Contents T))(= UpperLower "0" ))
(setq positionL nil)
;代替の単語を作成
(setq SWordLen (strlen SWord))
(setq SubText "")
(repeat SWordLen
(setq SubText (strcat SubText "$"))
)
;一旦、全部小文字にして、代替単語に置換NewContents。代替単語の位置をリストで記録PositionL
(setq NewContents Contents)
(while (vl-string-search (strcase SWord T) (strcase NewContents T))
(cond ((= position nil)(setq position 0))
((= position 0)(setq position 1))
(t (setq position (1+ position)))
)
(setq NewContents (vl-string-subst SubText (strcase SWord T) (strcase NewContents T)))
(setq Position (vl-string-search SubText NewContents Position))
(setq PositionL (append PositionL (list Position)))
)
;代替単語の埋め込まれた位置は、本来の置換文字に置き換えながら、左端から１文字ずつ移植し完成Answer
(setq OrgStrLen (strlen Contents))
(setq mm 0 Answer "")
(repeat OrgStrLen
(if ( member mm PositionL)
(progn (setq TransText RWord)
(setq mm (+ mm SWordLen -1))
)
(setq TransText (substr Contents (1+ mm) 1))
)
(setq Answer (strcat Answer TransText))
(setq mm (1+ mm))
)
(setq Data (subst (cons 1 Answer) (assoc 1 Data) Data))
(entmod Data)
)
)
)
;ダイアログからデータを取得++++++++++++++++++++++
(defun get_data_703( )
(if (and (get_tile "SearchWord") (get_tile "Replacement"))
(setq SWord (get_tile "SearchWord") RWord (get_tile "Replacement"))
)
(setq UpperLower (get_tile "UpperLower"))
(setq t1 (get_tile "t1"))
(vl-registry-write Path703 "SearchWord" SWord)
(vl-registry-write Path703 "Replacement" RWord)
(vl-registry-write Path703 "UpperLower" UpperLower)
(vl-registry-write Path703 "t1" t1)
)
;ダイアログからデータを取得++++++++++++++++++++++
(defun Write_Registry_703( )
(vl-registry-write Path703 "TxtStr1" TxtStr1)
(vl-registry-write Path703 "TxtStr2" TxtStr2)
)
;レジストリからデータを取得-----------------------------------------------------------------------------------------------
(defun RegistryRead_703()
(setq Path703 "HKEY_CURRENT_USER\\Software\\SpeedDraft\\SD_703")
(if (vl-registry-read Path703 "SearchWord" )
(set_tile "SearchWord" (vl-registry-read Path703 "SearchWord"))
)
(setq TxtStr1 (vl-registry-read Path703 "TxtStr1"))
(if (null TxtStr1)
(setq TxtStr1 "")
)
(setq TxtStr2 (vl-registry-read Path703 "TxtStr2"))
(if (null TxtStr2)
(setq TxtStr2 "")
)
(if (vl-registry-read Path703 "Replacement" )
(set_tile "Replacement" (vl-registry-read Path703 "Replacement"))
)
(if (vl-registry-read Path703 "UpperLower" )
(set_tile "UpperLower" (vl-registry-read Path703 "UpperLower" ))
)
(if (vl-registry-read Path703 "t1" )
(set_tile "t1" (vl-registry-read Path703 "t1" ))
)
)
(princ)
ReplaceTexts : dialog {label = "Replace Texts" ;initial_focus="SearchWord";
:column{
:edit_box {label="Search ";key="SearchWord"; allow_accept=true;edit_width=30;}
:edit_box {label="Replacement";key="Replacement";allow_accept=true;edit_width=30;}
:row{
:spacer {width =14;}
:list_box {width=30;Height=8;fixed_width="true";fixed_height="true";key="pl1";allow_accept=true;}
}
:toggle{label="Consider Uppercase/Lowercase.";key="UpperLower";}
:toggle{label="Whole text only.";key="t1";}
:spacer {height =1;}
:row{
ok_cancel_help;
}
}
}
ReplaceTexts_J : dialog {label = "文字置換" ;initial_focus="SearchWord";
:column{
:edit_box {label="検索する単語";key="SearchWord";allow_accept=true;edit_width=30;}
:edit_box {label="置換する単語";key="Replacement";allow_accept=true;edit_width=30;}
:row{
:spacer {width =14;}
:list_box {width=30;Height=8;fixed_width="true";fixed_height="true";key="pl1";allow_accept=true;}
}
:toggle{label="大文字・小文字を考慮する";key="UpperLower";}
:toggle{label="単語が完全に一致する場合のみ置換";key="t1";}
:spacer {height =1;}
:row{
ok_cancel_help;
}
}
}
コメント