[原创]：一个递增复制文字和属性块的程序

longer1000

能不能同时选择多个文本以及一个属性里面的多个文字属性同时增量

ZXF5611

下载不了

yuzb1314

好东西，下载使用下

KLDC

下载不了。
XDCAD人气差的原因吧。

下载不了，楼主能发一个给我吗？
ZHQ_GL@163.com

万分感谢！！

gysjy

已发往ZHQ_GL@163.com，请查收。

ljh19991220

楼主能不能增加汉字一二。。。。。的递增复制。
能不能发我一份ljh19991220@163.com,谢谢

xiaxiang

我想要，给我一份

KLDC

程序非常好用，非常感谢楼主。
好象天正的轴号不能增量复制。

gysjy

最初由 KLDC 发布
[B]
好象天正的轴号不能增量复制。 [/B]

我这里天正的轴号是可以复制的。请把你的图发上来看看。

KLDC

天正7.0自定义实体的轴号用不了。
论坛即不能上传，也不能下载。我发图到你的邮箱吧。

tm010111

我也下载不了，能否也发我一份，谢谢！
gongzi_yun@126.com

paladi

一直都在找这样一个东西，今天找到了，可惜下不了，楼主能否把最新更新后的直接贴出来，或者发一个给我，谢谢了。我的邮箱是JORL@163.COM.
再次感谢！
楼主，收到您发的LISP了，谢谢！您做得LISP很好，能否看看能不能做个两排文字的属性块，让下排的文字可以随上排的更改而自动修改，就是两排都是一样的文字。我想通过图层用这样的块来表达不同比例的图纸文字。

gysjy

最初由 paladi 发布
[B]看看能不能做个两排文字的属性块，让下排的文字可以随上排的更改而自动修改，就是两排都是一样的文字。我想通过图层用这样的块来表达不同比例的图纸文字。 .. [/B]

下面这个点改文字、属性和尺寸的程序或许对你有用：
[PHP](princ "\n欢迎使用点改文字、属性或尺寸程序!?\n此程序可以连续将目标文字、属性或尺寸改为源文字内容。  gysjy 2009.8")
(defun to (n)
  (cdr (assoc n (entget sn)))
)
(defun canzhao (/ sn p13 p14) ;;提取参照文字或属性内容：
  (setq sn (car (entsel (strcat "\n点取需用参照的文字、属性或尺寸<" text0 ">:"))))
  (if (= sn nil)
    (setq st text0)
    (if (or (= "TEXT" (to 0))(= "INSERT" (to 0))(= "DIMENSION" (to 0)))
      (if (= "INSERT" (to 0))        
        (setq st  (entget (entnext (cdr (car (entget sn)))))
              st (cdr (assoc 1 st))
        );;提取属性
        (progn  
          (if (= "DIMENSION" (to 0))
            (progn   ;;提取尺寸
              (setq p13 (to 13) p14 (to 14))
              (if (eq (to 1) "")
                 (setq st (* (fix (/ (+ (distance p13 p14) 4) 10)) 10)
                       st (itoa st)
                 )
                 (setq st (to 1))   
              )      
            )
            (setq st (to 1));;提取文字
          )
        )      
      );if
      (setq st "")      
    );if
  )
  (setq text0 st)
)
(defun c:nn(/ p sn en p1 nam ty e1 e2 st  p2 p3 p4 ss );点改文字、属性或尺寸
  (command "undo" "g")
  (setq os (getvar "osmode") blp (getvar "blipmode"))            
  (setvar "blipmode" 0)
  (setvar "osmode" 0)
  (graphscr)
  (if (null text0)(setq text0 ""))
  (canzhao)
  (while (setq p (entsel "\n点取要改的文字、属性或尺寸:"))
    (setq sn (car p) en (entget sn) p1 (to 10) nam (to 2) ty (to 0))
    (if (or (= "TEXT" ty)(= "INSERT" ty)(= "DIMENSION" ty))
      (if (or (= "TEXT" ty)(= "DIMENSION" ty))
        (progn                  ;; 将文字改为参照的文字内容         
          (setq e1 (subst (cons 1 st) (assoc 1 en) en))
          (entmod e1)
        );progn
        (progn                    ;; 将属性改为参照的文字内容
           (setq e1 (entget (entnext (cdr (car en)))))
           (setq e1 (subst (cons 1 st) (assoc 1 e1) e1))
           (entmod e1)(entmod en)
           (if (or (eq nam "PQ")(eq nam "PQ1"))(progn
             (setq e2 (entget (entnext (cdr (car e1)))))
             (setq e2 (subst (cons 1 st) (assoc 1 e2) e2))
             (entmod e2)(entmod en)
           ))
        );progn
      )
      (progn
        (princ "\n**所选物体是")
        (princ (cdr (assoc 0 en)))
        (princ ", 不是文字或图块,请重新选择.**\n")
      )
    )
  )
  (setvar "osmode" os)
  (setvar "blipmode" blp)
  (terpri)
  (command "undo" "end")
  (princ "          gysjy  2009.8.19 制作")
  (princ)
)[/PHP]

paladi

哦，谢谢楼主，这个LISP命令可以将后点的文字改成先点的文字啊！很好用的功能哦。不过要是出多比例的图的话，每次改了一个后还要执行这个LISP才行，而且如果关着的图层就不行了。
我又想了下我说的那种属性块，感觉用LISP是做不到的，但是可不可以做个LISP，用来一次将一个属性块中的各行文字一起修改？

gysjy

最初由 paladi 发布
[B]不过要是出多比例的图的话，每次改了一个后还要执行这个LISP才行，而且如果关着的图层就不行了。
我又想了下我说的那种属性块，感觉用LISP是做不到的，但是可不可以做个LISP，用来一次将一个属性块中的各行文字一起修改？... [/B]

还是不太明白你的意思。“一个属性块中的各行文字”是什么样的内容？