[编程申请]：麻烦写个块替换程序

xinxirong

在网上找到个块替换程序，但是有缺陷的：


(defun c:ck()
  (princ "\n选者需要修改的对象:<块>")
  (setq ss (ssget))
  (setq en_new (entsel "\n改为对象<块>: "))
  (setq n 0)
  (repeat (sslength ss)
    (setq en_old (ssname ss n))
    (setq en_old_data (entget en_old))
    (if (= (cdr (assoc 0 en_old_data)) "INSERT")
      (progn
    (setq na_old (assoc 2 en_old_data))
    (setq en_new_data (entget (car en_new)))
    (setq na_new (assoc 2 en_new_data))
    (setq en_old_data (subst na_new na_old en_old_data))
    (entmod en_old_data)
    )
      )
    (setq n (+ n 1))
      )
  )

该程序不能替换有属性字的块，替换之后会丢掉属性字的。

libo2000

(defun c:cheng_blth ( / ss bl blna i et xd)
        ;(chengs_getvar)
        ;(chengs_error)
        (princ "\n 选择需要替换的图块图元:")
        (setq ss (ssget (list '(0 . "INSERT"))))
        (princ "\n 选择替换后的图块图元:")
        (setq        bl (entsel  (list '(0 . "INSERT"))))
        (setq blna (cdr (assoc 2 (entget (car bl)))))

        (setq i 0)
        (while (setq et (ssname ss i))
                (setq i (1+ i))
                (chengs_change et 2 blna)
        );endwhile
        (princ " 修改ok!")
        ;(chengs_setvar)
        (princ)
);endfun c::cheng_blth

;;; 更新对象属性
(defun Chengs_change (ename assoc_num newdate / edate elist update)
        (if (listp ename)
                (setq elist (entget (car ename)))
                (setq elist (entget ename))
        )
        (if (= nil (numberp assoc_num))
                (exit)
        )
        (if (not (null newdate))
                (progn
                        (setq edate (assoc assoc_num elist))
                        (setq update (cons assoc_num newdate))
                        (if edate
                                (setq elist (subst
                                                                                        update
                                                                                        edate
                                                                                        elist
                                                                                )
                                )
                                (setq elist (append
                                                                                        elist
                                                                                        (list update)
                                                                                )
                                )
                        )
                        (entmod elist)
                )
        )
        ;(if (setq ename (car (reverse (cadddr ename)))) (entupd ename))

)

egos

在Express工具中有现成的块替换命令，不知是否合你用！

03hai

选择替换后的图块图元:; 错误: 参数类型错误: stringp ((0 . "INSERT"))