明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1735|回复: 2

[求助]我有两个可替换文字,多行文字,块属性的程序,但不会用,请教斑竹

[复制链接]
发表于 2006-7-1 13:10:00 | 显示全部楼层 |阅读模式

请问下面程序的执行命令是什么
(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

    还有,论坛似乎没有批量替换块中文字的程序?批量替换标注文字的程序也没有.有谁能填补此项空白

  • 发表于 2006-7-1 14:43:00 | 显示全部楼层

    lisp程序差Doslib是运行不了的(调用了dos_strreplace 函数),并且没有命令而是个函数

    vba的是偶编的:),你是怎么用的?

     楼主| 发表于 2006-7-1 17:05:00 | 显示全部楼层

    不好意思,我对编程一窍不通,lisp用不了?请楼上版主帮忙,看怎么才能使用

    楼主编的通配符查找vba怎么用啊?我是复制一个其它的vba放在cad2002的支持目录下,加载后alt+F8,再点编辑,然后拷贝楼主的vba,结果提示找不到工程或库,

    请问正确用法是?还有论坛里是否有批量替换块中文字的程序和批量替换标注文字程序?

    您需要登录后才可以回帖 登录 | 注册

    本版积分规则

    小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
    ©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

    GMT+8, 2024-11-27 03:14 , Processed in 0.178281 second(s), 23 queries , Gzip On.

    Powered by Discuz! X3.4

    Copyright © 2001-2021, Tencent Cloud.

    快速回复 返回顶部 返回列表