[讨论]剛剛寫的一個查找和替換程序
各位朋友一起完善这个功能帮手加强下. 我先起个头. 谢谢!;date: 2004-09-01<BR>;by BDYCAD<BR>;查找与替换<BR>; (reptext <要找的文字> <替换成的文字>)<BR>;应用举例:<BR>;;;(SETQ char-A "DRAWING1" char-B "BDYCADCAD")<BR>;;;(reptext char-A char-B)<BR>(defun reptext(char-A char-B / pc ss index ent index typeA cosd newsize )<BR> (setq pc 0 ss (ssget "x" '((0 . "TEXT"))))<BR> (setq index 0 )<BR> (repeat (sslength ss)<BR> (setq ent (entget (ssname ss index)))<BR> (setq index (+ 1 index))<BR> (setq typeA (assoc 1 ent)<BR> cosd (substr (cdr typeA) 1 (strlen char-A)))<BR> (if (= cosd char-A)<BR> (progn<BR> (setq newsize (cons 1 (if (> (strlen (cdr typeA))(strlen char-B))<BR> (strcat char-B (substr (cdr typeA) (strlen char-A)))<BR> char-B)))<BR> (setq ent (subst newsize typeA ent))<BR> (setq pc (1+ pc))<BR> (entmod ent))))<BR> (princ (strcat "\n替换了" (rtos pc)"个."))<BR>) 日常灌水，到此一看 CAD中有FIND命令的。 这个我明白. 可是我是要在程序调用的. 请问可以在lisp程序直接调用 find 命令(不用对话框方式)去查找替换?我没有做过. 但好象不行的. 所以就写了. 但现在程序功能很弱. (defun Replace (ename oldtext newtext / NewDoc)
(setq obj (vlax-ename->vla-object ename))
(setq tj (cdr (assoc 0 (entget ename))))
(if (not (and (= "" oldtext) (= "" newtext)))
(progn
(cond
((or (= tj "MTEXT") (= tj "TEXT"))
(setq text1 (vla-get-textstring obj))
;;(setq text11 (krsubst newtext oldtext text1))
(setq text11 (dos_strreplace text1 oldtext newtext))
(setq text1_ok (vla-put-textstring obj text11))
)
((= tj "INSERT")
(setq variantvalue
(vlax-variant-value (vla-GetAttributes obj))
)
(if (/= -1 (vlax-safearray-get-u-bound variantvalue 1))
(progn
(setq list_att (vlax-safearray->list variantvalue))
(setq list_len (vl-list-length list_att))
(setq ct 0)
(repeat list_len
(setq text1 (vla-get-textstring (nth ct list_att)))
;;(setq text11 (krsubst newtext oldtext text1))
(setq text11 (dos_strreplace text1 oldtext newtext))
(setq text1_ok
(vla-put-textstring (nth ct list_att) text11)
)
(setq ct (1+ ct))
)
)
)
)
((= tj "ATTDEF")
(setq text1 (vla-get-tagstring obj))
;;(setq text11 (krsubst newtext oldtext text1))
(setq text11 (dos_strreplace text1 oldtext newtext))
(setq text1_ok (vla-put-tagstring obj text11))
)
)
)
(progn
(alert "原文字和新文字均为空还替换什么呢？白费劲！")
(exit)
)
)
(princ)
)这是我很早前写的一个程序中的一部分，调用了DOSLIB中的dos_strreplace函数，实际上也可写个程序来代替dos_strreplace函数的！它不只是可以替换Text或Mtext！ 原来cad中有个自带的chtext.lsp文件，可以实现文字替换，就是不支持mtext 这是我以前编的一个通配符号替换程序是VBA的<BR>'支持通配符*格式的替换<BR>'例：*(*)->*[*]或A*B*->B*C*<BR>'支持替换前后*的数量不等<BR>Public Sub SuperReplace()<BR>On Error Resume Next<BR>Dim ss As AcadSelectionSet<BR>Dim str As String<BR>Dim pStart As String, pEnd As String<BR>Dim i As AcadEntity, j<BR>Dim ft(1) As Integer, fd(1)<BR>Dim pSS, pES<BR>Dim pStrs() As String<BR>Dim pSpec As String
ThisDrawing.SelectionSets("*TlsText*").Delete<BR>Set ss = ThisDrawing.SelectionSets.Add("*TlsText*")
pStart = Trim(ThisDrawing.Utility.GetString(True, "替换前："))<BR>pEnd = Trim(ThisDrawing.Utility.GetString(True, "替换后："))<BR>pSS = Split(pStart, "*")<BR>pES = Split(pEnd, "*")<BR>pSpec = Replace(pStart, "`", "``")<BR>pSpec = Replace(pSpec, "[", "`[")<BR>pSpec = Replace(pSpec, "]", "`]")<BR>pSpec = Replace(pSpec, ",", "`,")<BR>pSpec = Replace(pSpec, "@", "`@")<BR>pSpec = Replace(pSpec, "~", "`~")<BR>pSpec = Replace(pSpec, ".", "`.")<BR>pSpec = Replace(pSpec, "?", "`?")<BR>ft(0) = 0: fd(0) = "*Text"<BR>ft(1) = 1: fd(1) = pSpec<BR>ss.SelectOnScreen ft, fd
<BR>For Each i In ss<BR>If UBound(pES) = 0 Then<BR>i.TextString = pEnd<BR>Else<BR>str = i.TextString<BR>ReDim pStrs(UBound(pSS) + 1) As String<BR>For j = 0 To UBound(pSS)<BR>pStrs(j) = LeftStr(str, pSS(j)) & pES(j)<BR>str = RightStr(str, pSS(j))<BR>Next j
pStrs(UBound(pSS) + 1) = str<BR>i.TextString = Join(pStrs, "")<BR>End If<BR>Next i
ThisDrawing.SelectionSets("*TlsText*").Delete
End Sub 支持 TEXT和MTEXT，如果要查找的文字为 "" 会把新的文字加在开头
只替换文字中子文字,不是替换掉整个文字
演示文件,将0.010替换成0.050
试了. 很好用. 在lisp程序直接调用 find 命令,用对话框方式(设计或改进DCL来解决数据传递).初步估计能行. 为什么不用
(setq ss (ssget (list '(0 . "*Text") (cons 1 (strcat "*" char-A "*")))))
？
页:
[1]
2