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

paladi · 发表于 2009-8-22 00:40:18

楼主，属性块打开编辑的时候不是有几排吗？我就想有个LISP命令可以用来一次将这几排的文字内容一起改（比如都是办公室1，一次都改为休息室），但是每排保持自己的特性，比如：字高，所属图层，字体等。

gysjy · 发表于 2009-8-22 19:41:41

最初由 paladi 发布
[B]楼主，属性块打开编辑的时候不是有几排吗？我就想有个LISP命令可以用来一次将这几排的文字内容一起改（比如都是办公室1，一次都改为休息室），但是每排保持自己的特性，比如：字高，所属图层，字体等。 [/B]

我明白你的意思了。但这个问题很复杂。而且我建议你绘图最好不要用一个属性块包含很多个属性的绘制方法，这样手工修改属性很麻烦。如果改绘制成若干个文字，改起来就容易得多。

paladi · 发表于 2009-8-23 02:14:58

谢谢楼主的建议，我想这样做的目的主要是想通过图层和字体来达到不同的显示方式，如果这个LISP做成功了，那将会带来非常大的便利。尤其是使用镜像外部参照的图，就可以通过这样的属性块解决字体反向的问题（可以将块的其中一排文字属性设为反向，这样在图案反向后，文字反倒正确了）。楼主：这个LISP能做成功吗？谢谢了

gysjy · 发表于 2009-8-23 10:01:11

最初由 paladi 发布
[B]楼主，属性块打开编辑的时候不是有几排吗？我就想有个LISP命令可以用来一次将这几排的文字内容一起改（比如都是办公室1，一次都改为休息室），但是每排保持自己的特性，比如：字高，所属图层，字体等。 [/B]

下图是不是你所需要的：
程序还在进一步调试和简化中，请稍侯。

paladi · 发表于 2009-8-23 15:49:00

楼主，就是这个意思，谢谢您！发布期待中ING...

gysjy · 发表于 2009-8-23 21:28:56

[PHP](defun to(n)
  (cdr (assoc n (entget sn)))
)
(defun nextstr()
  (setq sn1  (entnext sn1)
      s (entget (entnext (cdr (car (entget sn1)))))
      str1 (cdr (assoc 1 s))
  )
  str1
)
(princ "\n本程序用来统一修改属性块内的所有属性。  === gysjy0@163.com  2009.8.23 ===")
(defun c:nn( / s sn sn1 str)
  (setq *error* nil)
  (command "undo" "g")
  (if (setq sn (car (entsel "\n点取属性块:")))
(progn
   (if (and (to 66)(= "INSERT" (to 0)))
      (progn
      (setq str (getstring "\n请输入新属性:"))
      (setq s (entget (entnext (cdr (car (entget sn)))))
            sn1 sn
      )
      (setq s (subst (cons 1 str) (assoc 1 s) s))
      (entmod s)(entmod (entget sn))
      (while (nextstr)
         (setq s (subst (cons 1 str) (assoc 1 s) s))
         (entmod s)(entmod (entget sn))
      )
      )
      (princ "\n*** 你所点取的图元不是属性块！***")
   )
)
  )
  (command "undo" "e")
  (princ)
)
[/PHP]

paladi · 发表于 2009-8-23 23:33:32

牛！楼主，您真是太强了！佩服，佩服。Autodesk公司都没有解决的问题被您的这个LISP命令解决了。以后镜像的东西就省好多事了。非常感谢您！
Gysjy楼主，我又有了一个过分的请求，就是能否在属性块序号排好后，重新用点击的方式来重新排序号啊。就是比如我从05开始点，假如设为加1，然后点下一个就自动增序，而不管原来的序号。。。这样行不行啊？因为编房间号的时候老是会漏编或者改顺序，就得不停地重排，要是可以直接按点击顺序来排号就方便了。谢谢了！

gysjy · 发表于 2009-8-26 08:14:18

最初由 paladi 发布
[B]就是能否在属性块序号排好后，重新用点击的方式来重新排序号啊。就是比如我从05开始点，假如设为加1，然后点下一个就自动增序，而不管原来的序号?.. [/B]

你的意思是不是编辑已有的序号？

paladi · 发表于 2009-8-26 09:20:56

是啊，楼主，就是序号编好后老是要修改，要是可以直接点击增序就好了，我这几天正在编房间号，一层就有160多个号呢，要是其中一个改了，后面就好麻烦哦。

gysjy · 发表于 2009-8-26 19:42:40

好的，我试试。不过需要一点时间哦。

paladi · 发表于 2009-8-27 08:36:47

好啊，谢谢Gysjy ，现在情况怎么样了啊，LISP修改顺利吗，好久可以发布啊～～

gysjy · 发表于 2009-8-29 21:24:41

将主程序修改如下：
[PHP](defun c:nn( / asc e1 e2 en en1 k l loop p p1 p2 sn sn1 st st1 st2)
  ;(setq *error* nil)
  (command "undo" "g")
  (princ "\n欢迎使用文字或属性块连续增量修改程序! GYSJY  2009.8.29")
  (if (setq sn (entsel "\n点取初始文字或属性块:"))
(progn
   (setq p1 (cadr sn) p2 t sn (car sn) loop t)
   (if (or (= "TEXT" (to 0))(and p2 (to 66)(= "INSERT" (to 0))))
      (progn
      (tqwz)
      (tqtxt)
      (setq l (1+ l ))
      (while (setq sn (car (entsel "\n点取后续文字或属性块：")))
         (setq en (entget sn))
         ;(tqwz);(princ st)(getstring)
         (setq asc (ascii st))
         (if (or (= "TEXT" (to 0))(and p2 (to 66)(= "INSERT" (to 0))))
            (if (and (= (strlen st) 1)
                  (or (and (> asc 64) (< asc 90))
                     (and (> asc 96) (< asc 122))
                  )
               );判断字符串是否是单个字母
            (setq k (if (or (= asc 78)(= asc 72))(+ asc 2)(1+ asc));排除字母I,O
                  st (chr k)
            ) ;如果字符串是单个字母，则按字母顺序增长
            (setq st2 (substr st l) st2 (tost2)
                  st (strcat st1 st2)
            ) ;按数字增长
            )
            (princ "===>刚才点取的不是文字或属性块\n")
         )
         (if (= "TEXT" (to 0))
            (progn
            (setq e1 (subst (cons 1 st) (assoc 1 en) en))
            (entmod e1)
            );修改文字
            (if (or loop p)
            (progn
               (setq e1 (entget (entnext (cdr (car en)))))
               (setq e1 (subst (cons 1 st) (assoc 1 e1) e1))
               (entmod e1)(entmod en)
            )
            (progn
               (setq  sn1(entnext sn) en1 (entget sn1)
                  e1 (entget (entnext (cdr (car en1))))
                  e2 (subst (cons 1 st) (assoc 1 e1) e1)
               )
               (entmod e2)(entmod en1)(entmod en)
            )
            );修改属性
         )
         (princ st)
      )
      )
      (princ "\n ***你所点取的图元不是属性块或文字!本程序只修改带属性的块或文字。***")
   )
      )
  )
  (command "undo" "e")
  (princ)
)[/PHP]

paladi · 发表于 2009-8-30 01:17:00

Gysjy大侠，动画里的效果正是我需要的命令，谢谢，只是一执行就出现“点取初始文字或属性块:no function definition: TO”的提示啊，请问这个LISP是不是都是认属性块的第一个属性啊。

jhwjm369 · 发表于 2009-8-30 07:58:52

怎么论坛无法对帖子进行收藏了啊。。。。

gysjy · 发表于 2009-8-30 08:22:53

最初由 paladi 发布
[B]只是一执行就出现“点取初始文字或属性块:no function definition: TO”的提示啊，请问这个LISP是不是都是认属性块的第一个属性啊。 [/B]

你要把cptext.lsp 用记事本打开，替换里面的主程序。

账号		自动登录	找回密码
密码			立即注册