正文

对ACAD图中文本内容的批修改2006-05-15 10:25:00

【评论】 【打印】 【字体: 】 本文链接:http://blog.pfan.cn/otot/14091.html

分享到:

;;本文件用于批处理AUTOCAD中的文本内容修改,是chtext.lsp的简化。
;;主要语句取材chtext.lsp(在R14版本中测试通过)


(defun c:ct (/ last_o tot_o ent o_str n_str st s_temp n_slen o_slen si chf chm cont ans class)
                      
          ;; Select objects if running standalone
 
  (setq objs (ssget))

  (setq chm 0)              ;统计修改次数
  (if objs    
    (progn                                 ;; If any objects selected
      (if (= (type objs) 'ENAME)           ;如果objs为一个实体名
        (progn
          (setq ent (entget objs))         ;将以OBJS为名的表抽出放入ENT
          (princ (strcat "\nExisting string: " (cdr (assoc 1 ent))))
        )       ;搜出ENT中的文字内容
        (if (= (sslength objs) 1)    ;又或OBJS集合里只有一个内容
          (progn
            (setq ent (entget (ssname objs 0)))   ;将集里的东西的表抽出
            (princ (strcat "\nExisting string: " (cdr (assoc 1 ent))))
          )       ;将其文字内容搜出来
        )
      )
      (setq o_str (getstring "\nMatch string   : " t))   ;输入!
      (setq o_slen (strlen o_str))    ;求输入的字长
      (if (/= o_slen 0)      ;字长为非0
        (progn       ;则
          (setq n_str (getstring "\nNew string     : " t)) ;输入!
          (setq n_slen (strlen n_str))    ;求输入的字长
          (setq last_o 0
                tot_o  (if (= (type objs) 'ENAME)  ;tot_o设为集合的实体数量
                         1
                         (sslength objs)
                       )
          )
                 ;; For each selected object...
          (while (< last_o tot_o)
            (setq class (cdr (assoc 0 (setq ent (entget (ssname objs last_o))))))
            (if (or (= "TEXT" class)    ;ENT为被动手术的表
                    (= "MTEXT" class) )
              (progn
                (setq chf nil si 1)
                (setq s_temp (cdr (assoc 1 ent)))  ;ENT中的文字内容
                (while (= o_slen (strlen (setq st (substr s_temp si o_slen))))
                  (if (= st o_str)    ;o_slen为输入旧的串的长
                    (progn     ;比较!
                      (setq s_temp (strcat    ;如果相同,则重组文字内容
                                     (if (> si 1)
                                       (substr s_temp 1 (1- si))
                                       ""
                                     )
                                     n_str
                                     (substr s_temp (+ si o_slen))
                                   )
                      )
                      (setq chf t)       ;; 标记Found old string
                      (setq si (+ si n_slen))   ;指针往下跳
                    )
                    (setq si (1+ si))    ;若不同,则指针只跳一
                  )
                )
                (if chf
                  (progn                 ;; 替代 new string for old
                          ;; 修正 the TEXT 实体
                    (entmod (subst (cons 1 s_temp) (assoc 1 ent) ent))
                    (setq chm (1+ chm))    ;统计修改次数
                  )
                )
              )
            )
            (setq last_o (1+ last_o))    ;做下一个目标的手术
          )
        )
               ;; else go on to the next line...
      )
    )
  )
  (if (/= (type objs) 'ENAME)
            ;; Print total lines changed
    (if (/= (sslength objs) 1)
      (princ (strcat (rtos chm 2 0) " text lines changed."))
    )
  )
  (terpri)
)
(PRINC "\n\t Change the text that you select.")
(princ "\n\tCT command loaded.")
(princ)

阅读(3426) | 评论(0)


版权声明:编程爱好者网站为此博客服务提供商,如本文牵涉到版权问题,编程爱好者网站不承担相关责任,如有版权问题请直接与本文作者联系解决。谢谢!

评论

暂无评论
您需要登录后才能评论,请 登录 或者 注册