[求助]：块内文字修改！

qjcpj · 发表于 2004-11-7 16:34:57

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本人写了一段块内文字修改程序，使用entmod更新后AutoCAD屏幕不会更新，必须使用regen命令重生成才行，请大家帮忙修改，以下是程序源代码！

(defun c:edit_bl ( / ent ent_pt ent_name entbl entbl_dxf entbl_name wzstr wzstr_old wzstr_new)
(setq ent (entsel))
(setq ent_pt (nth 1 ent))
(setq ent_name (cdr (assoc 0 (entget (car ent)))))
(if (= ent_name "INSERT")
(progn
(setq entbl (nentselp ent_pt))
(setq entbl_dxf (entget (car entbl)))
(setq entbl_name (cdr (assoc 0 entbl_dxf)))
(if (or (= entbl_name "TEXT") (= entbl_name "MTEXT"))
(progn
(setq wzstr (getstring "\n 输入新文字: "))
(setq wzstr_old (assoc 1 entbl_dxf))
(setq wzstr_new (cons 1 wzstr))
(setq entbl_dxf (subst wzstr_new wzstr_old entbl_dxf))
(entmod entbl_dxf)
(command "regen")
)
(alert "\n 程序不能处理该实体！")
)
)
)
)

(defun c:edit_bl        ( / ent ent_pt ent_name entbl entbl_dxf entbl_name wzstr wzstr_old wzstr_new) 
        (setq ent (entsel)) 
        (setq ent_pt (nth 1 ent)) 
        (setq ent_name (cdr (assoc 0 (entget (car ent))))) 
        (if        (= ent_name "INSERT") 
                (progn 
                        (setq entbl (nentselp ent_pt)) 
                        (setq entbl_dxf (entget (car entbl))) 
                        (setq entbl_name (cdr (assoc 0 entbl_dxf))) 
                        (if        (or (= entbl_name "TEXT") (= entbl_name "MTEXT")) 
                                (progn 
                                        (setq wzstr (getstring "\n 输入新文字: ")) 
                                        (setq wzstr_old (assoc 1 entbl_dxf)) 
                                        (setq wzstr_new (cons 1 wzstr)) 
                                        (setq entbl_dxf (subst wzstr_new wzstr_old entbl_dxf)) 
                                        (entmod entbl_dxf) 
                                        (command "regen") 
                                ) 
                                (alert "\n 程序不能处理该实体！") 
                        ) 
                ) 
        ) 
)

mmmm · 发表于 2004-11-7 16:57:43

Add one line:
....
(entmod entbl_dxf)
(entupd (car ent))
.....

blackspot · 发表于 2004-11-7 17:05:03

entupd函数对块内定义内容的修改仍然不能显示更新，还是需要调用"regen"命令的。
顺便说一句，autocad 2000以上已有一个命令"refedit"可以更改块内定义的内容和其它一些属性

mmmm · 发表于 2004-11-7 17:11:59

maybe change to
...
(entmod...)
(setq ent (car ent))
(repeat 2 (entdel ent))
...

PS: This will only update the operated parent block, others need a regen to update.

qjcpj · 发表于 2004-11-10 12:50:37

前几日本人计算机出故障不能上网，昨天上网参考2楼楼主的帖子，使用entupd函数，可以不使用regen命令就可更新块内实体，谢谢！

urljit · 发表于 2004-12-20 20:13:18

楼上：你说的entupd只能更新你选择的块内实体吧

qjcpj · 发表于 2004-12-20 20:52:14

Yes，函数entupd只能更新所选择的块内实体！因我发的帖子是询问所选择块内文字entmod后AutoCAD屏幕更新问题，利用entupd函数确实解决了这一难题。
最近我上传的gxwz更新文字模块，其中使用了entupd函数更新块内文字，在此，利用这个机会，再次向2楼楼主表示感谢！
经过试验，我发现如果所选择编辑的块为图形数据库中多个同名块中的一个，要更新图形数据库中所有的同名块，使用4楼楼主的办法更好；其实，使用entupd函数更新多个同名块，虽然图面上显示的是只更新了所选择的图块，其实所有的同名块内核已被更新了。
最笨，其实也是最有效的办法，我想仍然是使用regen命令更新屏幕，只是此法有一缺点，就是图形数据库较大时屏幕刷新较慢!

urljit · 发表于 2004-12-20 22:00:14

我想到一个快速有效的方法，楼主可以试试：更新所有特定名子的insert（块），关键是找到方法。再者，如果用户需要更新块里面的文字，是更新块定义吗？程序的定位应该弄弄。

建议，将程序做成：如果用户更改的是块内文字，增加一个块的定义，新块内包含的是新文字。

qjcpj · 发表于 2004-12-20 23:02:13

8楼楼主的建议，我会认真考虑。确实，虽然我接触AutoLISP多年，但在各位支柱会员面前还是一个“小学生”，所编程序也才能算是小打小闹，自娱自乐，还希望各位多多帮助！
另8楼楼主的“增加一个块的定义”，是否使用entmake函数生成，能给一个例子吗？

Free-Lancer · 发表于 2004-12-21 01:15:41

(defun c:tt (/ e e1 bel el oldstr newstr tl)
(if (and (setq e (entsel))
(= (cdr (assoc 0 (setq bel (entget (car e))))) "INSERT")
(setq e1 (nentselp (cadr e)))
(= (length e1) 4)
(wcmatch (cdr (assoc 0 (setq el (entget (car e1)))))
"*TEXT"
)
)
(progn
(setq oldstr (cdr (setq tl (assoc 1 el))))
(princ "\nOld Text: ")
(princ oldstr)
(if (/= (setq newstr (getstring "\nNew Text: ")) "")
(progn
(entmod (subst (cons 1 newstr) tl el))
(if (setq ss (ssget "x" (list (assoc 2 bel))))
(progn
(setq l (sslength ss))
(while (> l 0)
(entupd (ssname ss (setq l (1- l))))
)
)
)
)
)
)
)
(princ)
)

(defun c:tt (/ e e1 bel el oldstr newstr tl) 
  (if (and (setq e (entsel)) 
           (= (cdr (assoc 0 (setq bel (entget (car e))))) "INSERT") 
           (setq e1 (nentselp (cadr e))) 
           (= (length e1) 4) 
           (wcmatch (cdr (assoc 0 (setq el (entget (car e1))))) 
                    "*TEXT" 
           ) 
      ) 
    (progn 
      (setq oldstr (cdr (setq tl (assoc 1 el)))) 
      (princ "\nOld Text: ") 
      (princ oldstr) 
      (if (/= (setq newstr (getstring "\nNew Text: ")) "") 
        (progn 
          (entmod (subst (cons 1 newstr) tl el)) 
          (if (setq ss (ssget "x" (list (assoc 2 bel)))) 
            (progn 
              (setq l (sslength ss)) 
              (while (> l 0) 
                (entupd (ssname ss (setq l (1- l)))) 
              ) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

Other For 2000+

(vl-load-com)
(defun c:tt (/ e e1 bel el oldstr newstr tl)
(defun updateblocks ()
(if (setq ss (ssget "x" (list (assoc 2 bel))))
(progn
(setq l (sslength ss))
(while (> l 0)
(entupd (ssname ss (setq l (1- l))))
)
)
)
)
(if (and (setq e (entsel))
(= (cdr (assoc 0 (setq bel (entget (car e))))) "INSERT")
(setq e1 (nentselp (cadr e)))
(= (length e1) 4)
(wcmatch (cdr (assoc 0 (setq el (entget (car e1)))))
"*TEXT"
)
)
(progn
(setq oldstr (cdr (setq tl (assoc 1 el))))
(princ "\nOld Text: ")
(princ oldstr)
(setq newstr (getstring "\nNew Text< Enter delete >: "))
(if (/= newstr "")
(progn
(entmod (subst (cons 1 newstr) tl el))
(updateblocks)
)
(progn
(vla-delete (vlax-ename->vla-object e1))
(updateblocks)
)
)
)
)
(princ)
)

(vl-load-com) 
(defun c:tt (/ e e1 bel el oldstr newstr tl) 
  (defun updateblocks () 
    (if        (setq ss (ssget "x" (list (assoc 2 bel)))) 
      (progn 
        (setq l (sslength ss)) 
        (while (> l 0) 
          (entupd (ssname ss (setq l (1- l)))) 
        ) 
      ) 
    ) 
  ) 
  (if (and (setq e (entsel)) 
           (= (cdr (assoc 0 (setq bel (entget (car e))))) "INSERT") 
           (setq e1 (nentselp (cadr e))) 
           (= (length e1) 4) 
           (wcmatch (cdr (assoc 0 (setq el (entget (car e1))))) 
                    "*TEXT" 
           ) 
      ) 
    (progn 
      (setq oldstr (cdr (setq tl (assoc 1 el)))) 
      (princ "\nOld Text: ") 
      (princ oldstr) 
      (setq newstr (getstring "\nNew Text< Enter delete >: ")) 
      (if (/= newstr "") 
        (progn 
          (entmod (subst (cons 1 newstr) tl el)) 
          (updateblocks) 
        ) 
        (progn 
          (vla-delete (vlax-ename->vla-object e1)) 
          (updateblocks) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

qjcpj · 发表于 2004-12-21 07:36:02

多谢10楼楼主回复，程序收下了，研究下再说！

urljit · 发表于 2004-12-22 17:35:16

最初由 qjcpj 发布
[B]8楼楼主的建议，我会认真考虑。确实，虽然我接触AutoLISP多年，但在各位支柱会员面前还是一个“小学生”，所编程序也才能算是小打小闹，自娱自乐，还希望各位多多帮助！
另8楼楼主的“增加一个块的定义”，是否使用... [/B]

不要说那么多客气语言，彼此学习。

至于是否使用entmake增加一个块的定义，我也没有弄过，需要研究一下再说，你也自己试试吧。

k-777 · 发表于 2004-12-23 06:31:12

10楼的程序确实不错。不过不能修改块属性里面的文字。
看看这个：
(defun c:blt(/ c1 s11 s1 ed)
(setq s11 (nentsel "\n请选择块里的字:"))
  (if
(/= s11 nil)
(progn
(setq c1 (getstring T "\n要改成的字:"))
   (if
   (/= c1 "")
   (progn
   (setq s1 (car s11))
   (setq ed (entget s1))
   (setq ed
            (subst (cons 1 c1)
                  (assoc 1 ed)
                  ed
            )
   )
   (entmod ed)
   (command "regen")
   (princ)
   )
   )
)
  )
(princ)
)

luob72 · 发表于 2005-3-14 18:16:52

好东西，不过要是能有对话框就好了

MingSoft · 发表于 2005-3-15 14:37:42

http://www.mingsoft.net 的mingsoft.NET TOOLS里有这样的工具，命令edd，采用为超级编辑文字
是对话框的，支持多种形式的文字修改标注，文字，块内文字，块属性，属性定义，块内属性定义等。

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

[求助] [求助]：块内文字修改！

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子