[编程交流] 标题栏中属性的文本

(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 (entget  ent)
               )
           )
       )
   )
   (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 - [str] selection prompt
;; arg - [lst] 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)

(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 (entget  ent)
               )
           )
       )
   )
   (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 - [str] selection prompt
;; arg - [lst] 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)