[LISP函数]：一个小小程序，克隆文字

snoopychen

看了晓东工具箱里面很多关于文字的程序，似乎没有这个
就是画施工图的时候，很多时候要将一堆文字改成同一个文字
意思就是选定源文字，让目标文字都与之相同，于是小编一个程序
给各位高手见笑了，倒是比较常用就是

(defun c:gf()
        (setq a (car (entsel "the need text:")))
        (setq a (entget a))
        (setq ttext (cdr (assoc 1 a)))
        (setq i 1)
        (setq ss (SSGET))
          (setq n (sslength ss))
          (setq index 0)
          (repeat n
            (SETQ EN (SSNAME SS index))
            (setq index (+ index 1))
            (SETQ ed (ENTGET EN))
            (SETQ AS (CDR (ASSOC '0 ed)))
           
            (if (= AS "TEXT")
        (progn
                ;(setq ttext (cdr (assoc 1 ed)))
                                    (setq ed (subst (cons (car (assoc 1 ed)) ttext) (assoc 1 ed) ed ))
                                    (entmod ed)
        )
        )
        
        )
)

cy956

试试cy-gg.lsp.

wud0ng

很好实用！

逐月飞鸿

(defun c:MM (/ LEN MODELTXT SSTEXT TXTENT)
  (prompt "\n请选择源文字:")
  (setq sstext (ssget '((0 . "text"))))
  (if sstext
    (progn
      (setq modeltxt (cdr (assoc 1 (entget (ssname sstext 0)))))
      (repeat (setq len (sslength sstext))
(setq txtent (ssname sstext (setq len (1- len))))
(entmod
   (subst (cons 1 modeltxt)
   (assoc 1 (entget txtent))
   (entget (ssname sstext len))
   )
)
(entupd txtent)
      )
    )
  )
（PRINC）
)

lsjjm

以前论坛有贴过:
[php]
(defun c:test ()
  (vl-load-com)
  (setq ent (car (entsel "\nSelect Destination Text: ")))
  (setq dobj (vlax-ename->vla-object ent))
  (setq dtxt (vla-get-textstring dobj))
  (setq ss (ssget "x" '((0 . "*TEXT"))) n 0)
  (while (< n (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss n)))
    (vla-put-textstring obj dtxt)
    (setq n (1+ n))
  )
)
[/php]

小浪子

楼上的程序全都更换，这样不好啊！

zhuquanmao

最初由 小浪子 发布
[B]楼上的程序全都更换，这样不好啊！ [/B]

是啊 这样就没有什么使用价值了 下面是我编的 呵呵
;;; 文本内容刷

2. 
   
3.   [FONT=courier new]
   
4. (defun c:wbnrs (/ sourcetext sourcetextname sourcetextdata sourcetextcontent
   
5.                   denstextname index n ssa denstextdata denstextpro
   
6.                   denstextcontent
   
7.                )
   
8.   (setvar "CMDECHO" 0)
   
9.   (princ "\n<将源文本内容传递给别的文本>")
   
10.   (setq sourcetext (entsel "\n选择源文本: ")) ; 选择标注
    
11.   (setq sourcetextname (car sourcetext))
    
12.   (setq sourcetextdata (entget sourcetextname))        ; 获取实体全部数据
    
13.   (setq sourcetextcontent (cdr (assoc 1 sourcetextdata))) ; 提取文本内容
    
14.   (princ (strcat "\n要传递的文本为:<" sourcetextcontent ">"))
    
15.   (setq ssa (ssget))
    
16.   (setq n (sslength ssa))
    
17.   (setq index (- n 1))
    
18.   (repeat n
    
19.     (setq denstextname (ssname ssa index))
    
20.     (setq denstextdata (entget denstextname))
    
21.     (setq denstextpro (assoc 0 denstextdata))
    
22.     (setq index (1- index))
    
23.     (setq denstextcontent (cdr (assoc 1 denstextdata)))
    
24.     (if (= "TEXT" (cdr denstextpro))
    
25.       (command "change" denstextname "" "" "" "" "" "" sourcetextcontent)
    
26.     )
    
27.   )
    
28.   (princ)
    
29. )
    
30.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun c:wbnrs (/ sourcetext sourcetextname sourcetextdata sourcetextcontent<br />                   denstextname index n ssa denstextdata denstextpro<br />                   denstextcontent<br />                )<br />   (setvar "CMDECHO" 0)<br />   (princ "\n<将源文本内容传递给别的文本>")<br />   (setq sourcetext (entsel "\n选择源文本: ")) ; 选择标注<br />   (setq sourcetextname (car sourcetext))<br />   (setq sourcetextdata (entget sourcetextname))        ; 获取实体全部数据<br />   (setq sourcetextcontent (cdr (assoc 1 sourcetextdata))) ; 提取文本内容<br />   (princ (strcat "\n要传递的文本为:<" sourcetextcontent ">"))<br />   (setq ssa (ssget))<br />   (setq n (sslength ssa))<br />   (setq index (- n 1))<br />   (repeat n<br />     (setq denstextname (ssname ssa index))<br />     (setq denstextdata (entget denstextname))<br />     (setq denstextpro (assoc 0 denstextdata))<br />     (setq index (1- index))<br />     (setq denstextcontent (cdr (assoc 1 denstextdata)))<br />     (if (= "TEXT" (cdr denstextpro))<br />       (command "change" denstextname "" "" "" "" "" "" sourcetextcontent)<br />     )<br />   )<br />   (princ)<br /> )<br />   [/FONT]<br />

nuance

凑个热闹
支持－－文本，多行文本，属性值，三者可互刷，选物体只支持单选．
;match text(mtext,attrib) value
(defun c:cn(/ text1 content text2 dxf dxflayer dxflayer2 iflock layer)
(command "undo" "begin")
(while (= nil (cdr (assoc 1 (entget (car (setq text1 (nentsel "\nselect source text (attrib,mtext):")))))))
   (princ "\nobject is not a text (attrib,mtext)!")
)
(redraw (car text1) 3)
(setq content (assoc 1 (entget (car text1))))
(while;0
      (not (while (= nil (cdr (assoc 1 (setq dxf (entget (car
                        (setq text2 (nentsel "\nselect destination text (attrib,mtext):"))))))))
           (princ "\nobject is not a text (attrib,mtext)!")
        )
   );not
(if (= 4 (cdr (assoc 70 (tblsearch "layer" (cdr (assoc 8 dxf))))));0
   (progn  (alert "Destinatio object is on a locked layer !")(redraw (car text1) 4)(exit))
   (progn
      (if (or (= "TEXT" (cdr (assoc 0 dxf)))(= "MTEXT" (cdr (assoc 0 dxf))))
         (progn
            (setq dxf (subst content (assoc 1 dxf) dxf))
            (entmod dxf)
         )
      )
      (if (= "ATTRIB" (cdr (assoc 0 dxf)))
         (progn
            (setq dxf (subst content (assoc 1 dxf) dxf))
            (setq layer (cdr (assoc 8 dxf)))
            (setq iflock 0)
            (if (= 4 (cdr (assoc 70 (tblsearch "layer" layer))))
               (progn
                  (setq iflock 1)
                  (setq dxflayer (entget (tblobjname "layer" layer)))
                  (setq dxflayer2 dxflayer)
                  (setq dxflayer (subst (cons 70 0) (assoc 70 dxflayer) dxflayer))
                  (entmod dxflayer)
               )
            )
            (entmod dxf)
            (entupd (cdr (assoc 330 dxf)))
            (if (= 1 iflock)(entmod dxflayer2))
        )
     )
   )
);if0
(redraw (car text1) 4)
);while0
(command "undo" "end")
(princ)   
)

lsjjm

最初由 madman 发布
[B]...是啊 这样就没有什么使用价值了...[/B]

什么? 没有使用价值? 你用过吗?

andyhua5240

最初由 nuance 发布
[B]凑个热闹
支持－－文本，多行文本，属性值，三者可互刷，选物体只支持单选．
;match text(mtext,attrib) value
(defun c:cn(/ text1 content text2 dxf dxflayer dxflayer2 iflock layer)
(command "undo" "beg... [/B]

楼主可以参照这个程序进行改改，支持窗选，支持UNDO回退，自动记忆上一次所选的文本。
谢谢！
[iframe h=600]http://www.xdcad.net/forum/showthread.php?s=&threadid=49483[/iframe]

梦断江南

我试了楼上贴的."支持窗选，支持UNDO回退 "这两个没有啊?

qazxswedccc

我试了一下，还不错，赞一个

aeo

find

whcdy

８楼楼主，提点建议：
１、以尺寸标注为源对象，当目标为单行文本时，文本之前带了/A1;很不爽；
２、以多行文本为源对象，当目标为单行文本时，文本之间增加了\P；
３、好像attrib只能作为源对象，不能作为目标对象。
希望能够进一步完善，谢谢！

pxt2001

到底哪一个最好用，请大家评一下，真不知道下载哪个好。