[原创]：文字内容格式刷.支持text、mtext、attdef 、块属性文字、块中文字、标注文字

xshrimp

by xshrimp 2006.12.6
文字内容格式刷.支持text、mtext、attdef 、块属性文字、块中文字、标注文字
互刷

当刷块中的非属性文字时.弹出对话框选择是否所有块全改.
或者只修改选中图块.(将炸开图块.包括多重块.属性文字转化为文字.)

欢迎测试.

xshrimp

贴gif 动画为什么总是不成功????
操作预览

wharan

程序还不错，但不支持天正自定义对象。希望发出源程序，让大家共同完善

brainstorm

可否公开源码，我想知道如何取得属性块的值，并修改它，谢谢

smile313

是目前为止文字内容格式刷中最好的

qiaqiadeng

看我的源码,程序还需完善,对块内文字修改还不能"立杆见影",立即修改
(defun *$dyq-error$* (msg)
  ;(command ".undo" "")
  (setq *error* &olderr&)
  ;(princ)
)


(princ "\nT   文字内容刷子")
(defun c:T (/                 acadObject   acadDocument LayersObj        f             neirong
            w1                 objname      w2           laylock        TextOverride Measurement
            pickpoint         objhandl
           )
  (prompt "文字内容刷子")
  (setq &olderr& *error*)
  (setq *error* *$dyq-error$*)
  (vl-load-com)
  (setq acadObject (vlax-get-acad-object))
  (setq acadDocument (vlax-get-property acadObject 'ActiveDocument))
  (setq LayersObj (vla-get-layers acadDocument))
  (if (findfile "c:/clipboard.txt")
    (progn
      (setq f (open "c:/clipboard.txt" "r"))
      (setq neirong (read-line f))
      (close f)
      (if (= neirong nil)
        (setq neirong "")
      )
    )
    (setq neirong "")
  )
  (if (setq w1 (entsel (strcat "\n请选择源文字[" neirong "]:")))
    (progn
      (setq objname (cdr (assoc '0 (entget (car w1)))))
      (if
        (and (= objname "INSERT")
             (=        (vla-get-HasAttributes (vlax-ename->vla-object (car w1)))
                :vlax-true
             ) ;如果是有增强属性的块
        )
         (setq w1 (entget (entnext (car w1))))
         (if
           (and
             (= objname "INSERT")
             (=        (vla-get-HasAttributes (vlax-ename->vla-object (car w1)))
                :vlax-false
             )
             (wcmatch (cdr (assoc '0 (entget (car (nentselp (cadr w1))))))
                      "*TEXT,DIMENSION,INSERT,ATTDEF,AttributeRef,ATTRIB"
             )
           ) ;如果是无增强属性的块但是块内文字
            (setq w1 (entget (car (nentselp (cadr w1)))))
            (if
              (and
                (= objname "INSERT")
                (= (vla-get-HasAttributes
                     (vlax-ename->vla-object (car w1))
                   )
                   :vlax-false
                )
                (not (wcmatch
                       (cdr (assoc '0 (entget (car (nentselp (cadr w1))))))
                       "*TEXT"
                     )
                )
              ) ;如果是无增强属性的块但不是块内文字
               (progn
                 (setq w1 (list (cons 1 "")))
                 (prompt "\n未选中块内文字!")
               )
               (if (wcmatch objname "*TEXT") ;如果是文字
                 (setq w1 (entget (car w1)))
                 (if (wcmatch objname "DIMENSION")
                   (progn
                     (setq TextOverride (vla-get-TextOverride (vlax-ename->vla-object (car w1))))
                     (setq Measurement (vla-get-Measurement (vlax-ename->vla-object (car w1))))

                     (if (or (= TextOverride "")
                             (= TextOverride "<>")
                         ) ;如果是标注,并且替代标注为空或<>
                       (setq w1        (list
                                  (cons        1
                                        Measurement
                                  )
                                )
                       )
                       (if (and        (/= TextOverride "")
                                (/= TextOverride "<>")
                           )
                         (setq w1 (list
                                    (cons 1
                                          TextOverride
                                    )
                                  )
                         )
                       )
                     )
                   ) ;如果是标注,并且替代标注不为空或<>
                   (progn
                     (setq w1 (list (cons 1 "")))
                     (prompt "\n未选中标注或文字!") ;既不是标注也不是文字
                   )
                 )

               )
            )
         )
      )
      (setq neirong (cdr (assoc '1 w1)))
      (setq f (open "c:/clipboard.txt" "w"))
      (write-line neirong f)
      (close f)
    )
    (if        (findfile "c:/clipboard.txt")
      (progn
        (setq f (open "c:/clipboard.txt" "r"))
        (setq neirong (read-line f))
        (close f)
        (if (= neirong nil)
          (setq neirong "")
        )
      )
      (prompt
        "\n用来存储的文件[c:/clipboard.txt]不存在，请先选择一个文字以建一个文件!"
      )
    )
  )
  (if (and (/= neirong nil) (/= neirong ""))
    (progn
      (setq neirong (cons 1 neirong)) ;获得源文字的内容
      (while (setq w2 (entsel "\n请选择要修改的文字或编号:"))
        (setq pickpoint (cadr w2))
        (setq objhandl (car w2))
        (setq w2 (car w2))
        (setq objname (cdr (assoc '0 (entget w2))))
        (setq
          laylock (vla-get-lock
                    (vla-item LayersObj (cdr (assoc '8 (entget w2))))
                  )
        ) ;获得对象是否被锁定
        (if (= laylock
               :vlax-false
            ) ;如果没锁定
          (if
            (wcmatch objname
                     "*TEXT,DIMENSION,INSERT,ATTDEF,AttributeRef,ATTRIB"
            )
             (if (= objname "INSERT")
               (if (= (vla-get-HasAttributes (vlax-ename->vla-object w2))
                      :vlax-true
                   )
                 (progn
                   (setq w2 (entget (entnext w2)))
                   (setq w2 (subst neirong (assoc '1 w2) w2))
                   (entmod w2)
                   (entupd objhandl)
                 )
                 (if (wcmatch (cdr (assoc '0 (entget (car (nentselp pickpoint)))))
                              "*TEXT,DIMENSION,INSERT,ATTDEF,AttributeRef,ATTRIB"
                     ) ;如果是无增强属性的块但是块内文字
                   (progn
                     (setq w2 (entget (car (nentselp pickpoint))))
                     (setq w2 (subst neirong (assoc '1 w2) w2))
                     (entmod w2)
                     (entupd objhandl)
                   )
                   (prompt "\n该块内对象没有可编辑的属性!")
                 )
               )
               (progn
                 (setq w2 (entget w2))
                 (setq w2 (subst neirong (assoc '1 w2) w2))
                 (entmod w2)
               )
             )
             (prompt "\n所选择对象没有可编辑的属性!")
          )
          (prompt "\n所选择对象在一个锁定的图层上!")
        )
      )
    )
  )
  (setq *error* &olderr&)
  (princ)
)

qjcpj

能否在不同图形文档间互“刷”？

stan783

不同图形估计没那么强悍吧

userzhluserzhl

刷的时候如果能框选就好的

we3

这个有点意思，谢谢了

wzx21_ren

学习了,ok

liyl123

强啊,功能很强大

yaker_77

学习了，谢谢

yoyoho

跟楼主学习了!

laohuang

功能不错，谢谢共享，共同进步。