新增修改标注内容功能
在网上得到一个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)
)
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; by muwind
(defun getdimtext(ent / e el roop dim_text)
(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
)
;;; 修改 by HLCAD at 2021-1-9.
(defun C:tt (/ p l n e en os as ns st s sn nsl osl sl si chf chm)
(setq chm 0)
(if (setq p (ssget "x" '((0 . "*TEXT,DIM*")))) ; Select objects
;(if (setq p (ssget '((0 . "*TEXT,DIM*")))) ; Select objects
(progn ; If any objects selected
(while (= (setq osl (strlen (setq os (getstring "\nOriginal text: " t)))) 0)
(princ "Null input invalid")
)
(setq nsl (strlen (setq ns (getstring "\nTarget text: " t))))
(setq l 0 n (sslength p))
(while (< l n) ; For each selected object...
(if (and (setq sn (cdr (assoc 0 (setq e (entget (setq en (ssname p l)))))))
(member sn '("MTEXT" "TEXT" "DIMENSION")); Look for TEXT entity type (group 0)
)
(progn
(setq chf nil si 1)
(if (= sn "DIMENSION")
(setq s (getdimtext en) as (assoc 1 e))
(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 (strcat "edited " (itoa chm) " lines of text." )) ; Print total lines changed
(princ)
)
;;; 稍稍修改了一下：
;;; 修改 by HLCAD at 2021-1-7.
(defun C:tt (/ p l n e os as ns st s nsl osl sl si chf chm)
(setq chm 0)
(if (setq p (ssget "x" '((0 . "*TEXT,DIM*")))) ; Select objects
;(if (setq p (ssget '((0 . "*TEXT,DIM*")))) ; Select objects
(progn ; If any objects selected
(while (= (setq osl (strlen (setq os (getstring "\nOriginal text: " t)))) 0)
(princ "Null input invalid")
)
(setq nsl (strlen (setq ns (getstring "\nTarget text: " t))))
(setq l 0 n (sslength p))
(while (< l n) ; For each selected object...
(if (member (cdr (assoc 0 (setq e (entget (ssname p l))))) '("MTEXT" "TEXT" "DIMENSION")); Look for TEXT entity type (group 0)
(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 (strcat "edited " (itoa chm) " lines of text." )) ; Print total lines changed
(princ)
)
USER2128 发表于 2021-1-7 09:29
;;; 稍稍修改了一下：
谢谢帮忙。稍微有点遗憾，对于原始尺寸（标注后没有手工修改过的），无法修改标注内容。能帮忙再完善下吗 sunny_8848 发表于 2021-1-7 12:36
谢谢帮忙。稍微有点遗憾，对于原始尺寸（标注后没有手工修改过的），无法修改标注内容。能帮忙再完善下吗
以我从业三十几年的经验告诉你别这么干，不然后悔莫及！ USER2128 发表于 2021-1-7 16:06
以我从业三十几年的经验告诉你别这么干，不然后悔莫及！
谢谢提醒。我平时的图样基本不变，也就几十页的图纸，变化的是数据，哪些数据相同比较了解。如果方便，还是请您修改下，我小心使用就是 那个替换文本的貌似没有现在的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命令，个人您提的要求用处不大啊
muwind 发表于 2021-1-7 23:58
那个替换文本的貌似没有现在的find强大啊，find命令已经可以替换标注 属性块内对象了。
尺寸文本修改也简 ...
谢谢帮忙。CAD的查找替换有对话框，而我需要修改的和修改后的数据都是在命令行输入。能修改好您的代码吗， 本帖最后由 USER2128 于 2021-1-8 08:51 编辑
如果确定要动尺寸文本，就将“muwind”大侠的程序组合进去就行了
另外，请将悬赏的明经币给“muwind”大侠
USER2128 发表于 2021-1-8 08:49
如果确定要动尺寸文本，就将“muwind”大侠的程序组合进去就行了
另外，请将悬赏的明经币给“muwind”大侠 ...
不会整合啊，能帮忙弄一下吗
页:
[1]
2