新增修改标注内容功能

sunny_8848

在网上得到一个lsp，可以修改文本。现在想增加修改标注的内容功能（这样可以不炸开标注）,请大家帮忙。小附件都上传不了，只能复制源码了。(defun C:chtxt (/ p l n e os as ns st s nsl osl sl si chf chm cont)
   (setq chm 0 p (SSGET "x" '((0 . "*TEXT"))))            ; Select objects

   (if p (progn                      ; If any objects selected

      (setq cont t)
      (while cont
         (setq osl (strlen (setq os (getstring (vl-list->string(mapcar '(lambda (x)(boole 6 x 6))(list 12 73 116 111 97 111 104 103 106 38 114 99 126 114 60 38 ))) t))))
         (if (= osl 0)
            (princ (vl-list->string(mapcar '(lambda (x)(boole 6 x 6))(list 72 115 106 106 38 111 104 118 115 114 38 111 104 112 103 106 111 98 ))))
            (setq cont nil)
         )
      )
      (setq nsl (strlen (setq ns (getstring (vl-list->string(mapcar '(lambda (x)(boole 6 x 6))(list 12 82 103 116 97 99 114 38 114 99 126 114 60 38 ))) t))))
      (setq l 0 n (sslength p))
      (while (< l n)                 ; For each selected object...

         (if (OR (= (vl-list->string(mapcar '(lambda (x)(boole 6 x 6))(list 75 82 67 94 82 )))             ; Look for TEXT entity type (group 0)

                 (cdr (assoc 0 (setq e (entget (ssname p l))))))
   (= (vl-list->string(mapcar '(lambda (x)(boole 6 x 6))(list 82 67 94 82 )))             ; Look for TEXT entity type (group 0)

                 (cdr (assoc 0 (setq e (entget (ssname p l)))))))
            (progn
               (setq chf nil si 1)
               (setq s (cdr (setq as (assoc 1 e))))
               (while (= osl (setq sl (strlen
                             (setq st (substr s si osl)))))
                  (if (= st os)
                      (progn
                        (setq s (strcat (substr s 1 (1- si)) ns
                                        (substr s (+ si osl))))
                        (setq chf t)    ; Found old string

                        (setq si (+ si nsl))
                      )
                      (setq si (1+ si))
                  )
               )
               (if chf (progn        ; Substitute new string for old

                  (setq e (subst (cons 1 s) as e))
                  (entmod e)         ; Modify the TEXT entity

                  (setq chm (1+ chm))
               ))
            )
         )
         (setq l (1+ l))
      )
   ))
   (princ (vl-list->string(mapcar '(lambda (x)(boole 6 x 6))(list 99 98 111 114 99 98 38 ))))                ; Print total lines changed

   (princ chm)
   (princ (vl-list->string(mapcar '(lambda (x)(boole 6 x 6))(list 38 106 111 104 99 117 38 105 96 38 114 99 126 114 40 ))))
   (terpri)
)

USER2128

;;;

1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   
2. ;;; by muwind
   
3. (defun getdimtext(ent / e el roop dim_text)
   
4.   (if ent
   
5.     (progn
   
6.       (setq e (cdr (assoc -2 (tblsearch "block" (cdr (assoc 2 (entget ent )))))) roop T)
   
7.       (while roop
   
8.         (setq el (entget e   ))
   
9.         (setq e  (entnext e ))
   
10.         (if (member ( cons 0 "MTEXT") el)
    
11.           (setq roop nil)
    
12.           );end if
    
13.         );end while
    
14.       (if (or (wcmatch (cdr (assoc 1 (entget ent))) "*<>*,*<>,<>*")
    
15.               (= (cdr (assoc 1 (entget ent))) ""  ))
    
16.         (if  (wcmatch  (cdr (assoc 1 el )) "\\A1;*")
    
17.           ( setq dim_text (substr (cdr (assoc 1 el )) 5))
    
18.           ( setq dim_text (cdr (assoc 1 el )))
    
19.           );end if
    
20.         (cdr (assoc 1 (entget ent)))
    
21.         );end if
    
22.       );end progn
    
23.     );end if
    
24.   )
    
25. ;;; 修改 by HLCAD at 2021-1-9.
    
26. (defun C:tt (/ p l n e en os as ns st s sn nsl osl sl si chf chm)
    
27.   (setq chm 0)
    
28.   (if (setq p (ssget "x" '((0 . "*TEXT,DIM*"))))            ; Select objects
    
29. ;  (if (setq p (ssget '((0 . "*TEXT,DIM*"))))            ; Select objects
    
30.     (progn                      ; If any objects selected
    
31.       (while (= (setq osl (strlen (setq os (getstring "\nOriginal text: " t)))) 0)
    
32.         (princ "Null input invalid")
    
33.         )
    
34.       (setq nsl (strlen (setq ns (getstring "\nTarget text: " t))))
    
35.       (setq l 0 n (sslength p))
    
36.       (while (< l n)                 ; For each selected object...
    
37.         (if (and (setq sn (cdr (assoc 0 (setq e (entget (setq en (ssname p l)))))))
    
38.                  (member sn '("MTEXT" "TEXT" "DIMENSION")); Look for TEXT entity type (group 0)
    
39.                  )
    
40.           (progn
    
41.             (setq chf nil si 1)
    
42.             (if (= sn "DIMENSION")
    
43.               (setq s (getdimtext en) as (assoc 1 e))
    
44.               (setq s (cdr (setq as (assoc 1 e))))
    
45.               )
    
46.             (while (= osl (setq sl (strlen (setq st (substr s si osl)))))
    
47.               (if (= st os)
    
48.                 (progn
    
49.                   (setq s (strcat (substr s 1 (1- si)) ns (substr s (+ si osl))))
    
50.                   (setq chf t)    ; Found old string
    
51.                   
    
52.                   (setq si (+ si nsl))
    
53.                   )
    
54.                 (setq si (1+ si))
    
55.                 )
    
56.               )
    
57.             (if chf
    
58.               (progn        ; Substitute new string for old
    
59.                 (setq e (subst (cons 1 s) as e))
    
60.                 (entmod e)         ; Modify the TEXT entity
    
61.                
    
62.                 (setq chm (1+ chm))
    
63.                 ))
    
64.             )
    
65.           )
    
66.         (setq l (1+ l))
    
67.         )
    
68.       ))
    
69.   (princ (strcat "edited " (itoa chm) " lines of text." ))                ; Print total lines changed
    
70.   (princ)
    
71.   )
    
72. 
    

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> ;;; by muwind<br /> (defun getdimtext(ent / e el roop dim_text)<br />   (if ent<br />     (progn<br />       (setq e (cdr (assoc -2 (tblsearch "block" (cdr (assoc 2 (entget ent )))))) roop T)<br />       (while roop<br />         (setq el (entget e   ))<br />         (setq e  (entnext e ))<br />         (if (member ( cons 0 "MTEXT") el)<br />           (setq roop nil)<br />           );end if<br />         );end while<br />       (if (or (wcmatch (cdr (assoc 1 (entget ent))) "*<>*,*<>,<>*")<br />               (= (cdr (assoc 1 (entget ent))) ""  ))<br />         (if  (wcmatch  (cdr (assoc 1 el )) "\\A1;*")<br />           ( setq dim_text (substr (cdr (assoc 1 el )) 5))<br />           ( setq dim_text (cdr (assoc 1 el )))<br />           );end if<br />         (cdr (assoc 1 (entget ent)))<br />         );end if<br />       );end progn<br />     );end if<br />   )<br /> ;;; 修改 by HLCAD at 2021-1-9.<br /> (defun C:tt (/ p l n e en os as ns st s sn nsl osl sl si chf chm)<br />   (setq chm 0)<br />   (if (setq p (ssget "x" '((0 . "*TEXT,DIM*"))))            ; Select objects<br /> ;  (if (setq p (ssget '((0 . "*TEXT,DIM*"))))            ; Select objects<br />     (progn                      ; If any objects selected<br />       (while (= (setq osl (strlen (setq os (getstring "\nOriginal text: " t)))) 0)<br />         (princ "Null input invalid")<br />         )<br />       (setq nsl (strlen (setq ns (getstring "\nTarget text: " t))))<br />       (setq l 0 n (sslength p))<br />       (while (< l n)                 ; For each selected object...<br />         (if (and (setq sn (cdr (assoc 0 (setq e (entget (setq en (ssname p l)))))))<br />                  (member sn '("MTEXT" "TEXT" "DIMENSION")); Look for TEXT entity type (group 0)<br />                  )<br />           (progn<br />             (setq chf nil si 1)<br />             (if (= sn "DIMENSION")<br />               (setq s (getdimtext en) as (assoc 1 e))<br />               (setq s (cdr (setq as (assoc 1 e))))<br />               )<br />             (while (= osl (setq sl (strlen (setq st (substr s si osl)))))<br />               (if (= st os)<br />                 (progn<br />                   (setq s (strcat (substr s 1 (1- si)) ns (substr s (+ si osl))))<br />                   (setq chf t)    ; Found old string<br />                   <br />                   (setq si (+ si nsl))<br />                   )<br />                 (setq si (1+ si))<br />                 )<br />               )<br />             (if chf<br />               (progn        ; Substitute new string for old<br />                 (setq e (subst (cons 1 s) as e))<br />                 (entmod e)         ; Modify the TEXT entity<br />                 <br />                 (setq chm (1+ chm))<br />                 ))<br />             )<br />           )<br />         (setq l (1+ l))<br />         )<br />       ))<br />   (princ (strcat "edited " (itoa chm) " lines of text." ))                ; Print total lines changed<br />   (princ)<br />   )<br /> <br />

USER2128

;;; 稍稍修改了一下：

1. ;;; 修改 by HLCAD at 2021-1-7.
   
2. (defun C:tt (/ p l n e os as ns st s nsl osl sl si chf chm)
   
3.   (setq chm 0)
   
4.   (if (setq p (ssget "x" '((0 . "*TEXT,DIM*"))))            ; Select objects
   
5. ;  (if (setq p (ssget '((0 . "*TEXT,DIM*"))))            ; Select objects
   
6.     (progn                      ; If any objects selected
   
7.       (while (= (setq osl (strlen (setq os (getstring "\nOriginal text: " t)))) 0)
   
8.         (princ "Null input invalid")
   
9.         )
   
10.       (setq nsl (strlen (setq ns (getstring "\nTarget text: " t))))
    
11.       (setq l 0 n (sslength p))
    
12.       (while (< l n)                 ; For each selected object...
    
13.         (if (member (cdr (assoc 0 (setq e (entget (ssname p l))))) '("MTEXT" "TEXT" "DIMENSION")); Look for TEXT entity type (group 0)
    
14.           (progn
    
15.             (setq chf nil si 1)
    
16.             (setq s (cdr (setq as (assoc 1 e))))
    
17.             (while (= osl (setq sl (strlen (setq st (substr s si osl)))))
    
18.               (if (= st os)
    
19.                 (progn
    
20.                   (setq s (strcat (substr s 1 (1- si)) ns (substr s (+ si osl))))
    
21.                   (setq chf t)    ; Found old string
    
22.                   
    
23.                   (setq si (+ si nsl))
    
24.                   )
    
25.                 (setq si (1+ si))
    
26.                 )
    
27.               )
    
28.             (if chf
    
29.               (progn        ; Substitute new string for old
    
30.                 (setq e (subst (cons 1 s) as e))
    
31.                 (entmod e)         ; Modify the TEXT entity
    
32.                
    
33.                 (setq chm (1+ chm))
    
34.                 ))
    
35.             )
    
36.           )
    
37.         (setq l (1+ l))
    
38.         )
    
39.       ))
    
40.   (princ (strcat "edited " (itoa chm) " lines of text." ))                ; Print total lines changed
    
41.   (princ)
    
42.   )
    

;;; 修改 by HLCAD at 2021-1-7.<br /> (defun C:tt (/ p l n e os as ns st s nsl osl sl si chf chm)<br />   (setq chm 0)<br />   (if (setq p (ssget "x" '((0 . "*TEXT,DIM*"))))            ; Select objects<br /> ;  (if (setq p (ssget '((0 . "*TEXT,DIM*"))))            ; Select objects<br />     (progn                      ; If any objects selected<br />       (while (= (setq osl (strlen (setq os (getstring "\nOriginal text: " t)))) 0)<br />         (princ "Null input invalid")<br />         )<br />       (setq nsl (strlen (setq ns (getstring "\nTarget text: " t))))<br />       (setq l 0 n (sslength p))<br />       (while (< l n)                 ; For each selected object...<br />         (if (member (cdr (assoc 0 (setq e (entget (ssname p l))))) '("MTEXT" "TEXT" "DIMENSION")); Look for TEXT entity type (group 0)<br />           (progn<br />             (setq chf nil si 1)<br />             (setq s (cdr (setq as (assoc 1 e))))<br />             (while (= osl (setq sl (strlen (setq st (substr s si osl)))))<br />               (if (= st os)<br />                 (progn<br />                   (setq s (strcat (substr s 1 (1- si)) ns (substr s (+ si osl))))<br />                   (setq chf t)    ; Found old string<br />                   <br />                   (setq si (+ si nsl))<br />                   )<br />                 (setq si (1+ si))<br />                 )<br />               )<br />             (if chf<br />               (progn        ; Substitute new string for old<br />                 (setq e (subst (cons 1 s) as e))<br />                 (entmod e)         ; Modify the TEXT entity<br />                 <br />                 (setq chm (1+ chm))<br />                 ))<br />             )<br />           )<br />         (setq l (1+ l))<br />         )<br />       ))<br />   (princ (strcat "edited " (itoa chm) " lines of text." ))                ; Print total lines changed<br />   (princ)<br />   )<br />

sunny_8848

USER2128 发表于 2021-1-7 09:29
;;; 稍稍修改了一下：

谢谢帮忙。稍微有点遗憾，对于原始尺寸（标注后没有手工修改过的），无法修改标注内容。能帮忙再完善下吗

USER2128

sunny_8848 发表于 2021-1-7 12:36
谢谢帮忙。稍微有点遗憾，对于原始尺寸（标注后没有手工修改过的），无法修改标注内容。能帮忙再完善下吗

以我从业三十几年的经验告诉你别这么干，不然后悔莫及！

sunny_8848

USER2128 发表于 2021-1-7 16:06
以我从业三十几年的经验告诉你别这么干，不然后悔莫及！

谢谢提醒。我平时的图样基本不变，也就几十页的图纸，变化的是数据，哪些数据相同比较了解。如果方便，还是请您修改下，我小心使用就是

muwind

那个替换文本的貌似没有现在的find强大啊，find命令已经可以替换标注 属性块内对象了。
尺寸文本修改也简单
首先我们需要获取文本的数值，已经被修改的获取修改过后的，没有修改的就获取标注出来的，可以用下面的代码实现的
(defun getdimtext(ent / e el roop)
    (if ent
        (progn
           (setq e (cdr (assoc -2 (tblsearch "block" (cdr (assoc 2 (entget ent )))))) roop T)
           (while roop
              (setq el (entget e   ))
              (setq e  (entnext e ))
              (if (member ( cons 0 "MTEXT") el)
                    (setq roop nil)
               );end if
             );end while
      (if (or (wcmatch (cdr (assoc 1 (entget ent))) "*<>*,*<>,<>*")
                (= (cdr (assoc 1 (entget ent))) ""  ))
                (if  (wcmatch  (cdr (assoc 1 el )) "\\A1;*")
                      ( setq dim_text (substr (cdr (assoc 1 el )) 5))
                      ( setq dim_text (cdr (assoc 1 el )))
                 );end if
                 (cdr (assoc 1 (entget ent)))
      );end if
   );end progn
  );end if
)
获取了标注的文本就能想怎么替换怎么替换了
(defun c:tt ( / ss edat getdim N )     ；这里可以添加你要修改的数值 一个是被替换值一个是替换后的值
     ；两个getstring 就可以，不过精度问题可能会有判断上的麻烦
     (while  (setq ss (ssget (list (cons 0 "dimension"))))
          (repeat (setq N (sslength SS))
             (setq getdim (ssname ss (setq N (1- N))))
             (setq edat ( getdimtext getdim))
             ；edat就是获取的尺寸数值，可以与您输入的对比 然后确定是否修改，一个if就完成的事情
             (entmod (subst (cons 1 edat) (assoc 1 (entget getdim))  (entget getdim) ))
          );repeat
     );while
    (princ "您所选的全部尺寸替换完成")
)对于您的要求我修改一下上面的代码应该很好实现，
不过既然有了find命令，个人您提的要求用处不大啊

sunny_8848

muwind 发表于 2021-1-7 23:58
那个替换文本的貌似没有现在的find强大啊，find命令已经可以替换标注 属性块内对象了。
尺寸文本修改也简 ...

谢谢帮忙。CAD的查找替换有对话框，而我需要修改的和修改后的数据都是在命令行输入。能修改好您的代码吗，

USER2128

如果确定要动尺寸文本，就将“muwind”大侠的程序组合进去就行了
另外，请将悬赏的明经币给“muwind”大侠

sunny_8848

USER2128 发表于 2021-1-8 08:49
如果确定要动尺寸文本，就将“muwind”大侠的程序组合进去就行了
另外，请将悬赏的明经币给“muwind”大侠 ...

不会整合啊，能帮忙弄一下吗