请问下面程序的执行命令是什么 (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) )
另外还有一个vba程序,运行不了,我是cad2002,怎样调试? 一个通配符号替换程序是VBA的 '支持通配符*格式的替换 '例:*(*)->* 或A*B*->B*C* '支持替换前后*的数量不等 Public Sub SuperReplace() On Error Resume Next Dim ss As AcadSelectionSet Dim str As String Dim pStart As String, pEnd As String Dim i As AcadEntity, j Dim ft(1) As Integer, fd(1) Dim pSS, pES Dim pStrs() As String Dim pSpec As String
ThisDrawing.SelectionSets("*TlsText*").Delete Set ss = ThisDrawing.SelectionSets.Add("*TlsText*")
pStart = Trim(ThisDrawing.Utility.GetString(True, "替换前:")) pEnd = Trim(ThisDrawing.Utility.GetString(True, "替换后:")) pSS = Split(pStart, "*") pES = Split(pEnd, "*") pSpec = Replace(pStart, "`", "``") pSpec = Replace(pSpec, "[", "`[") pSpec = Replace(pSpec, "]", "`]") pSpec = Replace(pSpec, ",", "`,") pSpec = Replace(pSpec, "@", "`@") pSpec = Replace(pSpec, "~", "`~") pSpec = Replace(pSpec, ".", "`.") pSpec = Replace(pSpec, "?", "`?") ft(0) = 0: fd(0) = "*Text" ft(1) = 1: fd(1) = pSpec ss.SelectOnScreen ft, fd
For Each i In ss If UBound(pES) = 0 Then i.TextString = pEnd Else str = i.TextString ReDim pStrs(UBound(pSS) + 1) As String For j = 0 To UBound(pSS) pStrs(j) = LeftStr(str, pSS(j)) & pES(j) str = RightStr(str, pSS(j)) Next j
pStrs(UBound(pSS) + 1) = str i.TextString = Join(pStrs, "") End If Next i
ThisDrawing.SelectionSets("*TlsText*").Delete
End Sub
还有,论坛似乎没有批量替换块中文字的程序?批量替换标注文字的程序也没有.有谁能填补此项空白 |