同一个块内属性值从一个TAG拷贝到另外一个TAG

marting

(VL-LOAD-COM)
(defun c:rvb (/ _AttFunc ss i e values status void num)
  ;; Repair Revision Box
  (defun _AttFunc (en lst / vals v)
    (mapcar (function
              (lambda (at)
                (setq
                  vals (list (vla-get-tagstring at) (vla-get-textstring at))
                ) ;_ end of setq
                (if (and lst (setq v (assoc (car vals) lst)))
                  (vla-put-textstring at (cadr v))
                ) ;_ end of if
                vals
              ) ;_ end of lambda
            ) ;_ end of function
            (vlax-invoke
              (if (eq (type en) 'VLA-OBJECT)
                en
                (vlax-ename->vla-object en)
              ) ;_ end of if
              'Getattributes
            ) ;_ end of vlax-invoke
    ) ;_ end of mapcar
  ) ;_ end of defun
  (setq atlst '("REV#" "R#DESC" "R#BY" "R#CHK" "R#DATE"))
  (if (setq ss (ssget "X" '((0 . "INSERT") (66 . 1))))
    (repeat (setq i (sslength ss))
      (setq e (ssname ss (setq i (1- i))))
      (if (setq        values (vl-remove-if-not
                         '(lambda (x)
                            (setq tgnm (car x))
                            (vl-some
                              '(lambda (y)
                                 (wcmatch tgnm y)
                               ) ;_ end of lambda
                              atlst
                            ) ;_ end of vl-some
                          ) ;_ end of lambda
                         (_AttFunc e nil)
                       ) ;_ end of vl-remove-if-not
          ) ;_ end of setq
        (progn
          (setq        status nil
                void nil
          ) ;_ end of setq
          (repeat (setq num 7)
            (setq
              line (mapcar
                     '(lambda (s)
                        (vl-string-translate "#" (itoa num) s)
                      ) ;_ end of lambda
                     atlst
                   ) ;_ end of mapcar
            ) ;_ end of setq
            (if        (vl-every '(lambda (p)
                             (/= (cadr (assoc p values)) "")
                           ) ;_ end of lambda
                          line
                ) ;_ end of vl-every
              (setq status (cons num Status))
            ) ;_ end of if
            (setq num (1- num))
          ) ;_ end of repeat
          (repeat (- (setq lv (last status)) (car status))
            (if        (not (member (setq lv (1- lv)) status))
              (setq void (cons lv void))
            ) ;_ end of if
          ) ;_ end of repeat
          (if (and (setq from (car status))
                   (setq to (last void))
              ) ;_ end of and
            (progn
              (_AttFunc        e
                        (setq
                          data (mapcar '(lambda        (s)
                                          (list        (vl-string-translate
                                                  "#"
                                                  (itoa from)
                                                  s
                                                ) ;_ end of vl-string-translate
                                                ""
                                          ) ;_ end of list
                                        ) ;_ end of lambda
                                       atlst
                               ) ;_ end of mapcar
                        ) ;_ end of setq
              ) ;_ end of _AttFunc
              (_Attfunc        e
                        (mapcar        '(lambda (h)
                                   (list (vl-string-translate
                                           (itoa from)
                                           (itoa to)
                                           (car h)
                                         ) ;_ end of vl-string-translate
                                         (cadr (assoc (car h) values))
                                   ) ;_ end of list
                                 ) ;_ end of lambda
                                data
                        ) ;_ end of mapcar
              ) ;_ end of _Attfunc
            ) ;_ end of progn
          ) ;_ end of if
        ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of repeat
  ) ;_ end of if
  (princ)
) ;_ end of defun

marting

另外一个代码

(defun c:fixblk ( / a b i s x )
    (if (setq s (ssget "_:L" '((0 . "INSERT") (66 . 1))))
        (repeat (setq i (sslength s))
            (mapcar
               '(lambda ( a b )
                    (mapcar '(lambda ( a b ) (vla-put-textstring (last a) (caddr b))) a b)
                )
                (setq a
                    (vl-sort
                        (mapcar
                           '(lambda ( x )
                                (vl-remove nil
                                    (mapcar
                                       '(lambda ( p )
                                            (vl-some
                                               '(lambda ( a )
                                                    (if (wcmatch (cadr a) p) a)
                                                )
                                                x
                                            )
                                        )
                                       '("REV#" "R#DESC" "R#BY" "R#CHK" "R#DATE")
                                    )
                                )
                            )
                            (LM:groupbyfunction
                                (mapcar
                                   '(lambda ( a )
                                        (list
                                            (vl-list->string
                                                (vl-remove-if-not '(lambda ( x ) (< 47 x 58))
                                                    (vl-string->list (vla-get-tagstring a))
                                                )
                                            )
                                            (strcase (vla-get-tagstring a))
                                            (vla-get-textstring a)
                                            (progn (vla-put-textstring a "") a)
                                        )
                                    )
                                    (vl-remove-if-not
                                       '(lambda ( a )
                                            (wcmatch (strcase (vla-get-tagstring a))
                                                "REV#,R#DESC,R#BY,R#CHK,R#DATE"
                                            )
                                        )
                                        (vlax-invoke
                                            (vlax-ename->vla-object (ssname s (setq i (1- i))))
                                            'getattributes
                                        )
                                    )
                                )
                                (lambda ( a b ) (= (car a) (car b)))
                            )
                        )
                       '(lambda ( a b ) (> (caar a) (caar b)))
                    )
                )
                (vl-remove-if '(lambda ( x ) (vl-every '(lambda ( y ) (= "" (caddr y))) x)) a)
            )
        )
    )
    (princ)
)

;; Group By Function  -  Lee Mac
;; Groups items considered equal by a given predicate function

(defun LM:groupbyfunction ( lst fun / tmp1 tmp2 x1 )
    (if (setq x1 (car lst))
        (progn
            (foreach x2 (cdr lst)
                (if (fun x1 x2)
                    (setq tmp1 (cons x2 tmp1))
                    (setq tmp2 (cons x2 tmp2))
                )
            )
            (cons (cons x1 (reverse tmp1)) (LM:groupbyfunction (reverse tmp2) fun))
        )
    )
)

(vl-load-com) (princ)

kqqt6236

啥也不说了，感谢楼主分享哇！