我有两个可替换文字,多行文字,块属性的程序,但不会用,请教斑竹
<P>请问下面程序的执行命令是什么<BR>(defun Replace (ename oldtext newtext / NewDoc)<BR> (setq obj (vlax-ename->vla-object ename))<BR> (setq tj (cdr (assoc 0 (entget ename))))<BR> (if (not (and (= "" oldtext) (= "" newtext)))<BR> (progn<BR> (cond<BR> ((or (= tj "MTEXT") (= tj "TEXT"))<BR> (setq text1 (vla-get-textstring obj))<BR> ;;(setq text11 (krsubst newtext oldtext text1))<BR> (setq text11 (dos_strreplace text1 oldtext newtext))<BR> (setq text1_ok (vla-put-textstring obj text11))<BR> )<BR> ((= tj "INSERT")<BR> (setq variantvalue<BR> (vlax-variant-value (vla-GetAttributes obj))<BR> )<BR> (if (/= -1 (vlax-safearray-get-u-bound variantvalue 1))<BR> (progn<BR> (setq list_att (vlax-safearray->list variantvalue))<BR> (setq list_len (vl-list-length list_att))<BR> (setq ct 0)<BR> (repeat list_len<BR> (setq text1 (vla-get-textstring (nth ct list_att)))<BR> ;;(setq text11 (krsubst newtext oldtext text1))<BR> (setq text11 (dos_strreplace text1 oldtext newtext))<BR> (setq text1_ok<BR> (vla-put-textstring (nth ct list_att) text11)<BR> )<BR> (setq ct (1+ ct))<BR> )<BR> )<BR> )<BR> )<BR> ((= tj "ATTDEF")<BR> (setq text1 (vla-get-tagstring obj))<BR> ;;(setq text11 (krsubst newtext oldtext text1))<BR> (setq text11 (dos_strreplace text1 oldtext newtext))<BR> (setq text1_ok (vla-put-tagstring obj text11))<BR> )<BR> )<BR> )<BR> (progn<BR> (alert "原文字和新文字均为空还替换什么呢？白费劲！")<BR> (exit)<BR> )<BR> )<BR> (princ)<BR>)</P><P><BR>另外还有一个vba程序,运行不了,我是cad2002,怎样调试?<BR>一个通配符号替换程序是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</P>
<P>ThisDrawing.SelectionSets("*TlsText*").Delete<BR>Set ss = ThisDrawing.SelectionSets.Add("*TlsText*")</P>
<P>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</P>
<P><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</P>
<P>pStrs(UBound(pSS) + 1) = str<BR>i.TextString = Join(pStrs, "")<BR>End If<BR>Next i</P>
<P>ThisDrawing.SelectionSets("*TlsText*").Delete</P>
<P>End Sub</P>
<P>还有,论坛似乎没有批量替换块中文字的程序?批量替换标注文字的程序也没有.有谁能填补此项空白</P> <P>(Replace (car (entsel)) oldtext newtext)</P>
<P>试试 find</P> <P>本类程序实现起来比较简单.</P>
<P>版本高一点的AUTOCAS本身就提供了相应的功能.</P>
<P> </P> CAD不是有FIND命令吗？
页:
[1]