标题栏中属性的文本
大家好，我有几十个图形，其中有人使用文本，而不是将其添加到标题栏的属性值中。
文本位于属性的位置上方。我需要一种方法将文本推送到属性值。其中一些标题栏具有相当多的属性，因此复制/粘贴文本值非常繁琐。
我几乎可以肯定的是，我过去对此有Lisp程序的毛病，但我找不到。
任何帮助都将不胜感激。
干杯
法学博士 快速书写：
(defun c:attfix ( / blk ent enx idx lst sel )
(if (and (setq sel (LM:ssget "\nSelect text containing attribute values: " '("_:L" ((0 . "TEXT,MTEXT")))))
(setq blk (LM:ssget "\nSelect block to be populated: " '("_+.:E:S:L" ((0 . "INSERT") (66 . 1)))))
)
(progn
(repeat (setq idx (sslength sel))
(setq enx (entget (ssname sel (setq idx (1- idx))))
lst (cons (cons (cdr (assoc 10 enx)) (cdr (assoc 1 enx))) lst)
)
)
(setq ent (entnext (ssname blk 0))
enx (entget ent)
)
(while (= "ATTRIB" (cdr (assoc 0 enx)))
(entmod (subst (cons 1 (nearesttext (cdr (assoc 10 enx)) lst)) (assoc 1 enx) enx))
(setq ent (entnext ent)
enx (entgetent)
)
)
)
)
(princ)
)
(defun nearesttext ( pnt lst / dis rtn tmp )
(setq rtn (cdar lst)
dis (distance pnt (caar lst))
)
(foreach itm (cdr lst)
(if (< (setq tmp (distance pnt (car itm))) dis)
(setq rtn (cdr itm)
dis tmp
)
)
)
rtn
)
;; ssget-Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - selection prompt
;; arg - list of ssget arguments
(defun LM:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
(princ)
原文不会被删除（以防万一！）；不考虑没有相应文本项的属性。
李非常感谢你的帮助！它适用于大多数属性，但在某些属性上似乎有些奇怪。左边是文本，右边是标题栏，绿色文本仍显示不匹配。
谢谢Rlx
请尝试以下操作：
(defun c:attfix ( / blk ent enx idx lst sel )
(if (and (setq sel (LM:ssget "\nSelect text containing attribute values: " '("_:L" ((0 . "TEXT,MTEXT")))))
(setq blk (LM:ssget "\nSelect block to be populated: " '("_+.:E:S:L" ((0 . "INSERT") (66 . 1)))))
)
(progn
(repeat (setq idx (sslength sel))
(setq enx (entget (ssname sel (setq idx (1- idx))))
lst (cons (cons (textboxcen enx) (cdr (assoc 1 enx))) lst)
)
)
(setq ent (entnext (ssname blk 0))
enx (entget ent)
)
(while (= "ATTRIB" (cdr (assoc 0 enx)))
(entmod (subst (cons 1 (nearesttext (textboxcen enx) lst)) (assoc 1 enx) enx))
(setq ent (entnext ent)
enx (entgetent)
)
)
)
)
(princ)
)
(defun textboxcen ( enx )
(mapcar '/ (apply 'mapcar (cons '+ (text-box enx))) '(4.0 4.0 4.0))
)
(defun nearesttext ( pnt lst / dis rtn tmp )
(setq rtn (cdar lst)
dis (distance pnt (caar lst))
)
(foreach itm (cdr lst)
(if (< (setq tmp (distance pnt (car itm))) dis)
(setq rtn (cdr itm)
dis tmp
)
)
)
rtn
)
;; The following function is based on code by gile
(defun text-box ( enx / bpt hgt jus lst ocs org rot wid )
(cond
( (wcmatch(cdr (assoc 00 enx)) "ATTRIB,TEXT")
(setq bpt (cdr (assoc 10 enx))
rot (cdr (assoc 50 enx))
lst (textbox enx)
lst (list (car lst) (list (caadr lst) (cadar lst)) (cadr lst) (list (caar lst) (cadadr lst)))
)
)
( (= "MTEXT" (cdr (assoc 00 enx)))
(setq ocs(cdr (assoc 210 enx))
bpt(trans (cdr (assoc 10 enx)) 0 ocs)
rot(angle '(0.0 0.0) (trans (cdr (assoc 11 enx)) 0 ocs))
wid(cdr (assoc 42 enx))
hgt(cdr (assoc 43 enx))
jus(cdr (assoc 71 enx))
org(list (cond ((member jus '(2 5 ) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid)) (0.0))
(cond ((member jus '(1 2 3)) (- hgt)) ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0))
)
lst(list org (mapcar '+ org (list wid 0)) (mapcar '+ org (list wid hgt)) (mapcar '+ org (list 0 hgt)))
)
)
)
(if lst
( (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst))
(list
(list (cos rot) (sin (- rot)) 0.0)
(list (sin rot) (cos rot) 0.0)
'(0.0 0.0 1.0)
)
)
)
)
;; Matrix x Vector-Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)
;; ssget-Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - selection prompt
;; arg - list of ssget arguments
(defun LM:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
(princ)
太棒了我希望15年前有这样一个用户，他不仅使用文本，有时甚至会分解标题栏，并使用attdef的文本。到目前为止，他的大部分小手艺都已修复，但我们有很多图纸，所以谁知道呢，也许其中一些可能仍然存在；-）
gr.Rlx
我不知道更糟糕的是什么，标题栏爆炸还是维度爆炸…：大声笑：
据我所知
-新用户不知道什么是attributeblock（是的，他不知道什么是attribute）和/或想要通过更改维度值进行欺骗
-客户要求CAD文件，而顾问不想发布CAD文件，尤其是他花费时间和金钱创建的典型细节。 @李：你为什么不用边界框来确定文本的中心呢？
ActiveX boundingbox方法对于旋转文本、位于与WCS平面不平行的平面中的文本不会返回理想的结果，对于多行文字，boundingbox方法将扩展到多行文字窗口，而不是文本内容的边缘。 我理解你对多行文字的看法，但对于普通文本，因为边界框是围绕文本框计算的，文本的中心和边界框的中心始终是同一点。
页:
[1]